Delphi and other DIY

stm32g030 read analog PA0 and PA3 code with STM32CubeID

noreply@blogger.com (kobyx) — Mon, 05 Jun 2023 07:04:00 +0000

To read analog values from pins PA0 and PA3 on the STM32G030 microcontroller using STM32CubeIDE, you can follow these steps:

Open STM32CubeIDE and create a new project.
Select the appropriate board or microcontroller model (STM32G030 in this case).
Configure the necessary settings for your project, such as clock configuration and GPIO pins.
Enable the ADC peripheral:
- Go to the "Pinout & Configuration" tab.
- Select the desired ADC channel(s) for PA0 and PA3 by clicking on the respective pins.
- Assign the pins to the ADC peripheral.
- Click on the "ADC" peripheral in the "Middlewares" section.
- Enable the ADC and configure its settings, such as resolution, sampling time, and conversion mode.
In your code, include the necessary header files:

#include "stm32g0xx_hal.h"

1. Initialize the ADC and GPIO:

ADC_HandleTypeDef hadc;
GPIO_InitTypeDef GPIO_InitStruct;

void SystemClock_Config(void);
void Error_Handler(void);

void MX_GPIO_Init(void)
{
  /* GPIO Ports Clock Enable */
  __HAL_RCC_GPIOA_CLK_ENABLE();

  /*Configure GPIO pin : PA0 */
  GPIO_InitStruct.Pin = GPIO_PIN_0;
  GPIO_InitStruct.Mode = GPIO_MODE_ANALOG;
  GPIO_InitStruct.Pull = GPIO_NOPULL;
  HAL_GPIO_Init(GPIOA, &GPIO_InitStruct);

  /*Configure GPIO pin : PA3 */
  GPIO_InitStruct.Pin = GPIO_PIN_3;
  GPIO_InitStruct.Mode = GPIO_MODE_ANALOG;
  GPIO_InitStruct.Pull = GPIO_NOPULL;
  HAL_GPIO_Init(GPIOA, &GPIO_InitStruct);
}

void MX_ADC_Init(void)
{
  ADC_ChannelConfTypeDef sConfig;

  /* ADC Initialization */
  hadc.Instance = ADC1;
  hadc.Init.ClockPrescaler = ADC_CLOCK_ASYNC_DIV1;
  hadc.Init.Resolution = ADC_RESOLUTION_12B;
  hadc.Init.DataAlign = ADC_DATAALIGN_RIGHT;
  hadc.Init.ScanConvMode = ADC_SCAN_DISABLE;
  hadc.Init.EOCSelection = ADC_EOC_SINGLE_CONV;
  hadc.Init.LowPowerAutoWait = DISABLE;
  hadc.Init.LowPowerAutoPowerOff = DISABLE;
  hadc.Init.ContinuousConvMode = DISABLE;
  hadc.Init.DiscontinuousConvMode = DISABLE;
  hadc.Init.ExternalTrigConv = ADC_SOFTWARE_START;
  hadc.Init.ExternalTrigConvEdge = ADC_EXTERNALTRIGCONVEDGE_NONE;
  hadc.Init.DMAContinuousRequests = DISABLE;
  hadc.Init.Overrun = ADC_OVR_DATA_OVERWRITTEN;
  if (HAL_ADC_Init(&hadc) != HAL_OK)
  {
    Error_Handler();
  }

  /* Configure ADC channel */
  sConfig.Channel = ADC_CHANNEL_0; // PA0
  sConfig.Rank = 1;
  sConfig.SamplingTime = ADC_SAMPLETIME_13CYCLES_5;
  sConfig.SingleDiff = ADC_SINGLE_ENDED;
  sConfig.OffsetNumber = ADC_OFFSET_NONE;
  sConfig.Offset = 0;
  if (HAL_ADC_ConfigChannel(&hadc, &sConfig) != HAL_OK)
  {
    Error_Handler();
  }

  sConfig.Channel = ADC_CHANNEL_3; // PA3

  sConfig.Rank = 2;
  if (HAL_ADC_ConfigChannel(&hadc, &sConfig) != HAL_OK)
  {
    Error_Handler();
  }
}

int main(void)
{
  /* MCU Configuration */
  HAL_Init();
  SystemClock_Config();

  /* Initialize GPIOs and ADC */
  MX_GPIO_Init();
  MX_ADC_Init();

  /* Infinite loop */
  while (1)
  {
    /* Start ADC conversion */
    if (HAL_ADC_Start(&hadc) != HAL_OK)
    {
      Error_Handler();
    }

    /* Wait for conversion to complete */
    if (HAL_ADC_PollForConversion(&hadc, HAL_MAX_DELAY) != HAL_OK)
    {
      Error_Handler();
    }

    /* Read the converted value */
    uint32_t adcValue = HAL_ADC_GetValue(&hadc);

    /* Do something with the ADC value */
    // ...

    /* Stop ADC conversion */
    if (HAL_ADC_Stop(&hadc) != HAL_OK)
    {
      Error_Handler();
    }
  }
}

Make sure to handle any errors appropriately in the Error_Handler() function.

1. Build and flash your project to the STM32G030 microcontroller.

This code initializes the ADC peripheral and sets up PA0 and PA3 as analog inputs. Inside the infinite loop, it starts an ADC conversion, waits for it to complete, retrieves the converted value, and then stops the ADC conversion. You can perform any necessary processing or actions with the ADC value as required.

Remember to refer to the STM32G0 HAL reference manual and the STM32CubeG0 firmware package documentation for more details on the ADC and GPIO APIs and configurations specific to your needs.

Amazing Home automation system with STM32F103 microcontroller Part 1

noreply@blogger.com (kobyx) — Tue, 10 Nov 2020 14:48:00 +0000

Amazing Home automation system with STM32F103 microcontroller

Visit my Youtube channnels : Electro_Magic ; Practical Tips ; Delphi practical school

This is ongoing project of building Home automation system ( smart home system ), which will for the start have measurement of temperature and humidity.

It will consist of number of parts ( number of blog posts ).

It is planed to work with micro controller STM32F103C8T6

and 3.5" TFT LCD.

Next step will be to control relays for ceiling fan, etc.

Next will be to add ESP8266 to have connection to the internet, so the system can be controlled remotely.

Till now I have managed to make a printed circuit board.

Home automation board bottom

Home automation board top

Not really nice to look at, but it is working, and working from the first attempt :-)

The PCB is designed in EasyEDA, and made with toner transfer method

Except headers for STM32 and TFT LCD, I have also added 3.3V and 5.0V linear regulators.

Beside this, there is also part with MC34063 as a buck converter, which is in front of small linear regulators.

This part is made with intention to connect this device to external power source of 12V.

Of course, everything is programmed using Arduino IDE and STM32duino board.

For measuring temperature and humidity we use DHT11 sensor, which measures temperature and also humidity and uses just three wires, plus, ground and signal.

DIY method of making PCB using toner transfer method

noreply@blogger.com (kobyx) — Fri, 23 Oct 2020 18:46:00 +0000

This is a DIY method of making PCB using toner transfer method.

Visit my Youtube channnels : Electro_Magic ; Practical Tips ; Delphi practical school

The most important thing is to have good print , done with good quality toner.
Here we use some dangerous chemicals so be very careful if you going to do this at home.
Please check following video for details, and I will show you also few steps in following points.

As a first step we use sandpaper to remove any oxidation from copper plate, than clean it with paper tissue.

Than we use contact cleaner or acetone to clean any grease.

Then we secure the paper with printed circuit with adhesive tape.

Then we use nail polish remover ( or acetone - nail polish remover is actually acetone ), take small amount and spread it evenly on the surface of the copper plate.

Ten minutes after we can start to remove paper very slowly.

After we removed first layer of paper we put board into the water, and slowly rubbing we remove the rest of the paper.

This rubbing should be done VERY carefully, so we do not damage toner traces.

And in the end , the result is very satisfactory.

Next step will be to do the etching, which could be done with HCL and hydrogen peroxide.

Etching PCB with HCL and hydrogen peroxide

noreply@blogger.com (kobyx) — Thu, 20 Aug 2020 08:27:00 +0000

This is a DIY method of making PCB using HCL and hydrogen peroxide .

Visit my Youtube channnels : Electro_Magic ; Practical Tips ; Delphi practical school

The most important thing is to have good print , done with good quality toner.
Here we use some dangerous chemicals so be very careful if you going to do this at home.
Please check following video for details, and I will show you also few steps in following points.

First you must have good print, done with good quality toner.

Then we put prepared PCB in plastic box.

For etching we use HCL and Hydrogen peroxide.We pour in HCL just enough to cover PCB, then we add a little of peroxide.

We immediately see how reactions with copper occur.

Here we see bubbles in the reaction of acid with copper.

After few minutes we can see full reaction .

After etching is done, we rinse pcb with water.

Use a steel sponge to remove any toner residue.

The PCB looks almost perfect.

It is very important to have a well-done print at the very beginning, with quality toner.

Compress files and folders to zip file with Delphi (Tip for 10 )

noreply@blogger.com (kobyx) — Mon, 09 Apr 2018 16:29:00 +0000

Visit my Youtube channnels : Electro_Magic ; Practical Tips ; Delphi practical school

This is an example of zipping ( compressing ) files and folders with Delphi using "FWZip" component which can be downloaded from following link :

https://github.com/AlexanderBagel/FWZip

In this video you can see full procedure of this example :

And following is full source of this example :

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FWZipWriter, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    cmdOpenFoF: TButton;
    cmdClearList: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    rbFiles: TRadioButton;
    rbFolders: TRadioButton;
    rbSeparate: TRadioButton;
    rboneFile: TRadioButton;
    Label1: TLabel;
    Edit1: TEdit;
    cmdZip: TButton;
    FileOpenDialog1: TFileOpenDialog;
    Splitter1: TSplitter;
    procedure cmdClearListClick(Sender: TObject);
    procedure cmdOpenFoFClick(Sender: TObject);
    procedure rbSeparateClick(Sender: TObject);
    procedure rboneFileClick(Sender: TObject);
    procedure cmdZipClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   LoadedFiles:TStringList;
implementation

{$R *.dfm}

procedure TForm1.cmdClearListClick(Sender: TObject);
begin
ListBox1.Items.Clear;
LoadedFiles.Clear;
end;

procedure TForm1.cmdOpenFoFClick(Sender: TObject);
var
i:Integer;
begin
if rbFiles.Checked=true then
FileOpenDialog1.Options:=FileOpenDialog1.Options-[fdoPickFolders];
if rbFiles.Checked=false then
FileOpenDialog1.Options:=FileOpenDialog1.Options+[fdoPickFolders];

if FileOpenDialog1.Execute then
begin

for I := 0 to FileOpenDialog1.Files.Count - 1 do
begin
ListBox1.Items.Add(ExtractFileName(FileOpenDialog1.Files[i]));
LoadedFiles.Add(FileOpenDialog1.Files[i]);
end;
 Edit1.Text:=ExtractFileName(FileOpenDialog1.FileName);
end;

//now I have to create stringlist to handle full file names
end;

//now looks good, let's test
procedure TForm1.cmdZipClick(Sender: TObject);
var
FName,FNameOfSel,ZippedRoot:WideString;
i:Integer;
S:TStringStream;
PresentFiles:TStringList;
SR:TSearchRec;
Zip:TFWZipWriter;
BuildZipResult:TBuildZipResult;
begin
Screen.Cursor:=crHourGlass;
ZippedRoot:=ExpandFileName(ExtractFileDir(FileOpenDialog1.FileName));

if rbSeparate.Checked=true then
begin

for I := 0 to LoadedFiles.Count - 1 do
begin
Zip:=TFWZipWriter.Create;
Zip.UseUTF8String:=True;
FName:=LoadedFiles[i];
FNameOfSel:=ExtractFileName(FName);

if DirectoryExists(FName)=false then
begin
SetCurrentDir(ZippedRoot+'\');
S:=TStringStream.Create(FName);
S.Position:=0;
Zip.AddStream(FNameOfSel,S);
S.Free;
BuildZipResult:=Zip.BuildZip(ZippedRoot+'\'+FNameOfSel+'.zip');
ForceDirectories(ZippedRoot+'\');
Zip.Free;
end;

if DirectoryExists(FName)=true then
begin
SetCurrentDir(FName);
PresentFiles:=TStringList.Create;
if Zip.AddFolder('..\'+FNameOfSel+'\')=0 then
raise Exception.Create('Error adding data');

if FindFirst(FName+'*.*',faAnyFile,SR)=0 then
repeat
 if (SR.Name='.') or (SR.Name='..') then  Continue;
 PresentFiles.Add('AddFilesAndFolders\'+SR.Name+'=..\..\'+SR.Name);
until FindNext(SR)<>0;
FindClose(SR);
Zip.AddFilesAndFolders(PresentFiles,True);
PresentFiles.Free;
BuildZipResult:=Zip.BuildZip(ZippedRoot+'\'+FNameOfSel+'.zip');
ForceDirectories(ZippedRoot+'\');
Zip.Free;
end;

end;
end;

if rbSeparate.Checked=false then //ups
begin
Zip:=TFWZipWriter.Create;
Zip.UseUTF8String:=True;

for I := 0 to LoadedFiles.Count - 1 do
begin
FName:=LoadedFiles[i];
FNameOfSel:=ExtractFileName(FName);

if DirectoryExists(FName)=false then
begin
SetCurrentDir(ZippedRoot+'\');
S:=TStringStream.Create(FName);
S.Position:=0;
Zip.AddStream(FNameOfSel,S);
S.Free;
ForceDirectories(ZippedRoot+'\');
end;

if DirectoryExists(FName)=true then
begin
SetCurrentDir(FName);
PresentFiles:=TStringList.Create;
if Zip.AddFolder('..\'+FNameOfSel+'\')=0 then
raise Exception.Create('Error adding data');

if FindFirst(FName+'*.*',faAnyFile,SR)=0 then
repeat
 if (SR.Name='.') or (SR.Name='..') then  Continue;
 PresentFiles.Add('AddFilesAndFolders\'+SR.Name+'=..\..\'+SR.Name);
until FindNext(SR)<>0;
FindClose(SR);
Zip.AddFilesAndFolders(PresentFiles,True);
PresentFiles.Free;
ForceDirectories(ZippedRoot+'\');
end;

end;
BuildZipResult:=Zip.BuildZip(ZippedRoot+'\'+Edit1.Text+'.zip');
ForceDirectories(ZippedRoot+'\');
Zip.Free;
end;

Screen.Cursor:=crDefault;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LoadedFiles.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LoadedFiles:=TStringList.Create;  //No No No !!!!
end;

procedure TForm1.rboneFileClick(Sender: TObject);
begin
Edit1.Enabled:=True;
Label1.Enabled:=True;
end;

procedure TForm1.rbSeparateClick(Sender: TObject);
begin
Edit1.Enabled:=False;
Label1.Enabled:=False;
end;

end.

And Form file :

object Form1: TForm1
  Left = 299
  Top = 148
  Caption = 'Compress files and folders'
  ClientHeight = 385
  ClientWidth = 634
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 303
    Top = 0
    Height = 385
    Align = alRight
    ExplicitLeft = 321
    ExplicitTop = 156
    ExplicitHeight = 100
  end
  object ListBox1: TListBox
    Left = 306
    Top = 0
    Width = 328
    Height = 385
    Align = alRight
    ItemHeight = 13
    TabOrder = 0
  end
  object cmdOpenFoF: TButton
    Left = 8
    Top = 12
    Width = 173
    Height = 25
    Caption = 'Open file or folder'
    TabOrder = 1
    OnClick = cmdOpenFoFClick
  end
  object cmdClearList: TButton
    Left = 213
    Top = 12
    Width = 75
    Height = 25
    Caption = 'Clear list'
    TabOrder = 2
    OnClick = cmdClearListClick
  end
  object GroupBox1: TGroupBox
    Left = 8
    Top = 51
    Width = 280
    Height = 115
    Caption = 'Open files or folders'
    TabOrder = 3
    object rbFiles: TRadioButton
      Left = 12
      Top = 24
      Width = 113
      Height = 17
      Caption = 'Files'
      Checked = True
      TabOrder = 0
      TabStop = True
    end
    object rbFolders: TRadioButton
      Left = 12
      Top = 60
      Width = 113
      Height = 17
      Caption = 'Folders'
      TabOrder = 1
    end
  end
  object GroupBox2: TGroupBox
    Left = 8
    Top = 177
    Width = 280
    Height = 145
    Caption = 'Zip type selector'
    TabOrder = 4
    object Label1: TLabel
      Left = 12
      Top = 87
      Width = 43
      Height = 13
      Caption = 'Zip name'
      Enabled = False
    end
    object rbSeparate: TRadioButton
      Left = 12
      Top = 24
      Width = 113
      Height = 17
      Caption = 'Separate separate'
      Checked = True
      TabOrder = 0
      TabStop = True
      OnClick = rbSeparateClick
    end
    object rboneFile: TRadioButton
      Left = 12
      Top = 54
      Width = 113
      Height = 17
      Caption = 'Zip in one file'
      TabOrder = 1
      OnClick = rbOneFileClick
    end
    object Edit1: TEdit
      Left = 12
      Top = 103
      Width = 121
      Height = 21
      Enabled = False
      TabOrder = 2
    end
  end
  object cmdZip: TButton
    Left = 8
    Top = 342
    Width = 280
    Height = 25
    Caption = 'Zip'
    TabOrder = 5
    OnClick = cmdZipClick
  end
  object FileOpenDialog1: TFileOpenDialog
    DefaultFolder = '.\'
    FavoriteLinks = <>
    FileTypes = <>
    Options = [fdoAllowMultiSelect]
    Left = 207
    Top = 243
  end
end

Export Image To PDF with Delphi (Tip for 10 )

noreply@blogger.com (kobyx) — Wed, 03 Jan 2018 19:41:00 +0000

Visit my Youtube channnels : Electro_Magic ; Practical Tips ; Delphi practical school

This is example how one can export image from Delphi application to PDF file, using open source library SynPDF.

In the following video full procedure is described

Library can be downloaded from :
https://github.com/synopse/SynPDF

Following is full source code :
Edited 10.01.2018 : added code for the Form after main code.
(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg,SynPdf, ShellAPI;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Panel2: TPanel;
    ColorDialog1: TColorDialog;
    Panel3: TPanel;
    Button5: TButton;
    Button6: TButton;
    OpenDialog1: TOpenDialog;

    Panel4: TPanel;
    Button7: TButton;
    CheckBox1: TCheckBox;
    SaveDialog1: TSaveDialog;    procedure Button5Click(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public
   State:Integer;
   DrawColor:TColor;
   PenW:Integer;
  end;

var
  frmMain: TfrmMain;
  Drawing:Boolean;
  StartX,StartY,EndX,EndY:Integer;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
State:=1;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
State:=2;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
State:=3;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
State:=4;
end;

procedure TfrmMain.Button5Click(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
Image1.Width:=ClientWidth;
Image1.Height:=ClientHeight-60;
Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
end;
end;

procedure TfrmMain.Button6Click(Sender: TObject);
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Rectangle(0,0,Image1.Width-1,Image1.Height-1);
end;

procedure TfrmMain.Button7Click(Sender: TObject);
var
lPDF:TPdfDocument;
lPage:TPdfPage;
Jpegimage:TJPEGImage;
pdfimage:TPdfImage;
begin
if SaveDialog1.Execute() then
begin
lPDF:=TPdfDocument.Create;
try
  lPDF.DefaultPaperSize:=psA4;
  lPDF.DefaultPageLandscape:=CheckBox1.Checked;
  lPage:=lPDF.AddPage;
   Jpegimage:=TJPEGImage.Create;
   Jpegimage.Assign(Image1.Picture.Graphic);
   pdfimage:=TPdfImage.Create(lPDF,Jpegimage,true);
   lPDF.AddXObject('Image1',pdfimage);
   lPDF.Canvas.DrawXObject(0,lPage.PageHeight-Jpegimage.Height,Jpegimage.Width,Jpegimage.Height,'Image1');
   lPDF.SaveToFile(SaveDialog1.FileName+'.pdf');
   ShellExecute(Handle,'open',PChar(SaveDialog1.FileName+'.pdf'),nil,
   nil,SW_SHOWNORMAL);
finally
lPDF.Free;
end;
end;
end;

procedure TfrmMain.Edit1Change(Sender: TObject);
begin
PenW:=StrToInt(Edit1.Text);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
with Image1.Canvas do begin
  Pen.Color:=clWhite;
  Brush.Color:=clWhite;
  Rect(0,0,Image1.Width-1,Image1.Height-1);
  State:=1;
  DrawColor:=clBlack;
  PenW:=2;
end;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
Image1.Width:=ClientWidth;
Image1.Height:=ClientHeight-60;
Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
end;

procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing:=True;
StartX:=X; StartY:=Y;
EndX:=X; EndY:=Y;

if (State=1) or (State=2) then
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Pen.Width:=PenW;
end;

if State=4 then begin
Image1.Canvas.Pen.Color:=DrawColor;
Image1.Canvas.Pen.Width:=PenW;
Image1.Canvas.PenPos:=Point(X,Y);
end;

end;

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var
  PenColor:TColor;
begin
if Drawing=true then
begin
if State=1 then  begin      //start drawing line
 with Image1.Canvas do begin
   Pen.Mode:=pmXor;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
   Pen.Mode:=pmXor;
   MoveTo(StartX,StartY);
   LineTo(x,y);
 end;
 EndX:=X; EndY:=Y;
end;

if State=2 then begin    // start drawing rectangular
with Image1.Canvas do begin
  Pen.Mode:=pmXOR;
  MoveTo(StartX,StartY);
  LineTo(StartX,EndY);
  LineTo(EndX,EndY);
  LineTo(EndX,StartY);
  LineTo(StartX,StartY);
  Pen.Mode:=pmXOR;
  MoveTo(StartX,StartY);
  LineTo(StartX,y);
  LineTo(x,y);
  LineTo(x,StartY);
  LineTo(StartX,StartY);
end;
EndX:=X; EndY:=Y;
end;

if State=3 then begin    // start drawing ellipse
with Image1.Canvas do begin
PenColor:=Pen.Color;
Pen.Color:=Brush.Color;
Ellipse(StartX,StartY,EndX,EndY);
Pen.Color:=PenColor;
Ellipse(StartX,StartY,X,Y);
end;
EndX:=X; EndY:=Y;
end;

if State=4 then begin    // start drawing freehand
with Image1.Canvas do begin
LineTo(X,Y);
end;

end;

end;
end;

procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if State=1 then  begin      //end drawing line
 with Image1.Canvas do begin
   Pen.Mode:=pmXOR;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
   Pen.Color:=DrawColor;
   Pen.Mode:=pmCopy;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
 end;
 end;

 if State=2 then begin    // end drawing rectangular
with Image1.Canvas do begin
      Pen.Mode:=pmXOR;
      MoveTo(StartX,StartY);
      LineTo(StartX,EndY);
      LineTo(EndX,EndY);
      LineTo(EndX,StartY);
      LineTo(StartX,StartY);
      Pen.Color:=DrawColor;
      Brush.Color:=clWhite;
      Pen.Mode:=pmCopy;
      MoveTo(StartX,StartY);
      LineTo(StartX,EndY);
      LineTo(EndX,EndY);
      LineTo(EndX,StartY);
      LineTo(StartX,StartY);
  end;
end;

Drawing:=False;
end;

procedure TfrmMain.Panel2Click(Sender: TObject);
begin
if ColorDialog1.Execute() then
begin
Panel2.Color:=ColorDialog1.Color;
DrawColor:=ColorDialog1.Color;
Panel2.Repaint;

end;
end;

end.

Form code (copy to text editor and save as .DFM file ) :

object frmMain: TfrmMain
  Left = 256
  Top = 162
  Caption = 'Paint'
  ClientHeight = 451
  ClientWidth = 784
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  OnCreate = FormCreate
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 185
    Top = 0
    Width = 599
    Height = 451
    Align = alClient
    Stretch = True
    OnMouseDown = Image1MouseDown
    OnMouseMove = Image1MouseMove
    OnMouseUp = Image1MouseUp
    ExplicitLeft = 291
    ExplicitTop = 114
    ExplicitWidth = 105
    ExplicitHeight = 105
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 185
    Height = 451
    Align = alLeft
    TabOrder = 0
    object Label1: TLabel
      AlignWithMargins = True
      Left = 4
      Top = 128
      Width = 177
      Height = 13
      Align = alTop
      Caption = ' Line width'
      ExplicitWidth = 51
    end
    object Button1: TButton
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Line'
      TabOrder = 0
      OnClick = Button1Click
    end
    object Button2: TButton
      AlignWithMargins = True
      Left = 4
      Top = 35
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Rect'
      TabOrder = 1
      OnClick = Button2Click
    end
    object Button3: TButton
      AlignWithMargins = True
      Left = 4
      Top = 66
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Ellipse'
      TabOrder = 2
      OnClick = Button3Click
    end
    object Button4: TButton
      AlignWithMargins = True
      Left = 4
      Top = 97
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Freehand'
      TabOrder = 3
      OnClick = Button4Click
    end
    object Edit1: TEdit
      Left = 1
      Top = 141
      Width = 183
      Height = 21
      Align = alTop
      NumbersOnly = True
      TabOrder = 4
      Text = '2'
      OnChange = Edit1Change
    end
    object Panel2: TPanel
      Left = 1
      Top = 162
      Width = 183
      Height = 41
      Align = alTop
      Caption = 'Color'
      ParentBackground = False
      TabOrder = 5
      OnClick = Panel2Click
    end
    object Panel3: TPanel
      Left = 1
      Top = 258
      Width = 183
      Height = 192
      Align = alBottom
      TabOrder = 6
      object Button5: TButton
        AlignWithMargins = True
        Left = 4
        Top = 4
        Width = 175
        Height = 25
        Align = alTop
        Caption = 'Open bitmap'
        TabOrder = 0
        OnClick = Button5Click
      end
      object Button6: TButton
        Left = 1
        Top = 166
        Width = 181
        Height = 25
        Align = alBottom
        Caption = 'Clear all'
        TabOrder = 1
        OnClick = Button6Click
      end
      object Panel4: TPanel
        Left = 1
        Top = 111
        Width = 181
        Height = 55
        Align = alBottom
        TabOrder = 2
        object Button7: TButton
          Left = 1
          Top = 1
          Width = 179
          Height = 25
          Align = alTop
          Caption = 'Export to PDF'
          TabOrder = 0
          OnClick = Button7Click
          ExplicitLeft = 60
          ExplicitTop = 27
          ExplicitWidth = 75
        end
        object CheckBox1: TCheckBox
          AlignWithMargins = True
          Left = 4
          Top = 34
          Width = 173
          Height = 17
          Align = alBottom
          Caption = 'Landscape'
          TabOrder = 1
          ExplicitLeft = 63
          ExplicitTop = 42
          ExplicitWidth = 97
        end
      end
    end
  end
  object ColorDialog1: TColorDialog
    Left = 39
    Top = 213
  end
  object OpenDialog1: TOpenDialog
    Filter = 'Bitmap|*.bmp'
    Left = 108
    Top = 213
  end
  object SaveDialog1: TSaveDialog
    FileName = 'test'
    Filter = 'PDF File|*.pdf'
    InitialDir = '...'
    Left = 75
    Top = 315
  end
end

Draw shapes with Delphi (Tip for 10 )

noreply@blogger.com (kobyx) — Wed, 13 Dec 2017 13:42:00 +0000

In this tutorial you can learn how to draw shapes with Delphi.

This is actually example of how you can create your own Paint application.

In the video below you can see complete procedure of this tutorial.

Also, following is full source code :

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Panel2: TPanel;
    ColorDialog1: TColorDialog;
    Panel3: TPanel;
    Button5: TButton;
    Button6: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button5Click(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
   State:Integer;
   DrawColor:TColor;
   PenW:Integer;
  end;

var
  frmMain: TfrmMain;
  Drawing:Boolean;
  StartX,StartY,EndX,EndY:Integer;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
State:=1;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
State:=2;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
State:=3;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
State:=4;
end;

procedure TfrmMain.Button5Click(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;
end;

procedure TfrmMain.Button6Click(Sender: TObject);
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Rectangle(0,0,Image1.Width-1,Image1.Height-1);
end;

procedure TfrmMain.Edit1Change(Sender: TObject);
begin
PenW:=StrToInt(Edit1.Text);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
with Image1.Canvas do begin
  Pen.Color:=clWhite;
  Brush.Color:=clWhite;
  Rect(0,0,Image1.Width-1,Image1.Height-1);
  State:=1;
  DrawColor:=clBlack;
  PenW:=2;
end;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
Image1.Width:=ClientWidth;
Image1.Height:=ClientHeight-60;
Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
end;

procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing:=True;
StartX:=X; StartY:=Y;
EndX:=X; EndY:=Y;

if (State=1) or (State=2) then
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Pen.Width:=PenW;
end;

if State=4 then begin
Image1.Canvas.Pen.Color:=DrawColor;
Image1.Canvas.Pen.Width:=PenW;
Image1.Canvas.PenPos:=Point(X,Y);
end;

end;

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var
  PenColor:TColor;
begin
if Drawing=true then
begin
if State=1 then  begin      //start drawing line
 with Image1.Canvas do begin
   Pen.Mode:=pmXor;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
   Pen.Mode:=pmXor;
   MoveTo(StartX,StartY);
   LineTo(x,y);
 end;
 EndX:=X; EndY:=Y;
end;

if State=2 then begin    // start drawing rectangular
with Image1.Canvas do begin
  Pen.Mode:=pmXOR;
  MoveTo(StartX,StartY);
  LineTo(StartX,EndY);
  LineTo(EndX,EndY);
  LineTo(EndX,StartY);
  LineTo(StartX,StartY);
  Pen.Mode:=pmXOR;
  MoveTo(StartX,StartY);
  LineTo(StartX,y);
  LineTo(x,y);
  LineTo(x,StartY);
  LineTo(StartX,StartY);
end;
EndX:=X; EndY:=Y;
end;

if State=3 then begin    // start drawing ellipse
with Image1.Canvas do begin
PenColor:=Pen.Color;
Pen.Color:=Brush.Color;
Ellipse(StartX,StartY,EndX,EndY);
Pen.Color:=PenColor;
Ellipse(StartX,StartY,X,Y);
end;
EndX:=X; EndY:=Y;
end;

if State=4 then begin    // start drawing freehand
with Image1.Canvas do begin
LineTo(X,Y);
end;

end;

end;
end;

procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if State=1 then  begin      //end drawing line
 with Image1.Canvas do begin
   Pen.Mode:=pmXOR;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
   Pen.Color:=DrawColor;
   Pen.Mode:=pmCopy;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
 end;
 end;

 if State=2 then begin    // end drawing rectangular
with Image1.Canvas do begin
      Pen.Mode:=pmXOR;
      MoveTo(StartX,StartY);
      LineTo(StartX,EndY);
      LineTo(EndX,EndY);
      LineTo(EndX,StartY);
      LineTo(StartX,StartY);
      Pen.Color:=DrawColor;
      Brush.Color:=clWhite;
      Pen.Mode:=pmCopy;
      MoveTo(StartX,StartY);
      LineTo(StartX,EndY);
      LineTo(EndX,EndY);
      LineTo(EndX,StartY);
      LineTo(StartX,StartY);
  end;
end;

Drawing:=False;
end;

procedure TfrmMain.Panel2Click(Sender: TObject);
begin
if ColorDialog1.Execute() then
begin
Panel2.Color:=ColorDialog1.Color;
DrawColor:=ColorDialog1.Color;
Panel2.Repaint;

end;
end;

end.

LAB power supply with current control (Tip for 10 )

noreply@blogger.com (kobyx) — Thu, 30 Nov 2017 14:21:00 +0000

LAB power supply with current control from 0 to 1.5 Ampere (Tip for 10 )

This is simpler version of variable power supply shown in this post.

Voltage is variable from 0 to 30 Volts and current from 0 to 1.5 Ampere.

LM317T is mostly in standard setup.

Potentiometer for voltage control is connected to ADJ pin of LM317T and negative voltage via trim pot, with which you can adjust minimum voltage.

Current control is done using LM393 comparator and shunt resistror.

Output of LM393 is connected to ADJ pin of LM317T and regulates amperage, sensed over shunt resistor.

Get Base File Info (Tip for 10 )

noreply@blogger.com (kobyx) — Wed, 29 Nov 2017 19:52:00 +0000

Here you can see example of getting basic file information.

Complete procedure of making this example program can be seen in the following video.

And following is full source code that you can use to test this example by yourself.

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, ShellAPI;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

function GetFileSizeAsString(const FSize : Int64) : string; // Function to get size in bytes , KB,MB or GB
begin
  if FSize<1024 then Result := IntToStr(FSize)+ ' bytes'
  else begin
    if FSize<(1024*1024) then
    Result:=FormatFloat('####0.##',FSize/1024)+' KB'
    else
    if FSize<(1024*1024*1024) then
    Result:=FormatFloat('####0.##',FSize/1024/1024)+' MB'
        else
    Result:=FormatFloat('####0.##',FSize/1024/1024/1024)+' GB';
  end;
end;

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
var
itm:TListItem;
icn:HICON;
SHFileInfo:TSHFileInfo;
SearchRecord:TSearchRec;
Size:Integer;
begin
if OpenDialog1.Execute() then
begin
ListView1.Items.Clear;
SHGetFileInfo(PChar(OpenDialog1.FileName),0,SHFileInfo,SizeOf(TSHFileInfo),SHGFI_TYPENAME or
SHGFI_DISPLAYNAME or SHGFI_SYSICONINDEX or SHGFI_ICON);

FindFirst(OpenDialog1.FileName,0,SearchRecord);
Size:=SearchRecord.Size;

itm:=ListView1.Items.Add;
itm.Caption:='Display Name';
itm.SubItems.Add(SHFileInfo.szDisplayName);

itm:=ListView1.Items.Add;
itm.Caption:='Type Name';
itm.SubItems.Add(SHFileInfo.szTypeName);

itm:=ListView1.Items.Add;
itm.Caption:='Size';
itm.SubItems.Add(GetFileSizeAsString(Size));

itm:=ListView1.Items.Add;
itm.Caption:='Last Access Date Time';
itm.SubItems.Add(DateTimeToStr(FileDateToDateTime(SearchRecord.Time)));

itm:=ListView1.Items.Add;
itm.Caption:='Path';
itm.SubItems.Add(ExtractFilePath(OpenDialog1.FileName));

icn:=SHFileInfo.hIcon;
Image1.Picture.Icon.Handle:=icn;

end;
end;

end.

LM317 Variable power supply with current control (Tip for 10 )

noreply@blogger.com (kobyx) — Wed, 29 Nov 2017 15:15:00 +0000

In this post I will show you easy to construct variable power supply using LM317 with some other components.

Final result is usable variable lab power supply with current control.

Current control is done using LM393 comparator and shunt resistror.

Since I used one panel meter for voltage and current reading , I added LM358 OP amp to read current used by attached loads.

LM358 amplifies voltage detected on shunt resistor and amplify it to appropriate value which is set by variable trim pot.

Get Computer Drives - Delphi Tutorial (Tip for 10 )

noreply@blogger.com (kobyx) — Mon, 30 Oct 2017 18:56:00 +0000

In this example you can see how we can get list of Computer Drives with icons and labels.

First, check this video with details for this example .

And of course following is the source code of this example :

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI, Buttons, ExtCtrls, StdCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
var
fDriveSize:Cardinal;
fDrives: array[0..128] of Char;
fDrive : PChar;
flag:Cardinal;
infoFile:SHFILEINFO;
S:string;
btn:TSpeedButton;
iconx:TIcon;
begin

 try
 fDriveSize:=GetLogicalDriveStrings(SizeOf(fDrives),fDrives);
 if fDriveSize=0 then Exit;
 fDrive:=fDrives;

 while fDrive^<>#0 do
 begin
   btn:=TSpeedButton.Create(Panel1);
   btn.Parent:=Panel1;
   btn.Align:=alLeft;

   flag:=SHGFI_ICON;
   flag:=flag or SHGFI_SMALLICON or SHGFI_DISPLAYNAME;
   ZeroMemory(Addr(infoFile),SizeOf(infoFile));
   SHGetFileInfo(PChar(fDrive),0,infoFile,SizeOf(infoFile),flag);
   S:=infoFile.szDisplayName;

   iconx:=Ticon.Create;
   iconx.Handle:=infoFile.hIcon;

   btn.Glyph.Assign(iconx);
   btn.Caption:=S;
   btn.Width:=120;
   Inc(fDrive,Sizeof(fDrive));
   DestroyIcon(infoFile.hIcon);
   iconx.Free;
 end;
 finally

 end;
end;

end.

Web browser Delphi Example (Tip for 10 )

noreply@blogger.com (kobyx) — Fri, 13 Oct 2017 18:28:00 +0000

As you will see, it is possible to create simple Web browser very quickly using Delphi and component TWebBrowser , which encapsulates Internet Explorer ActiveX component.

In this video you can see all the details of creating such web browser :

And of course following is the source code for this example :

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    txtAddress: TEdit;
    cmdLoad: TButton;
    WebBrowser1: TWebBrowser;
    Panel1: TPanel;
    cmdBack: TButton;
    procedure FormCreate(Sender: TObject);
    procedure cmdLoadClick(Sender: TObject);
    procedure cmdBackClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 // Simple example which can be built to be a real web browser.
var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.cmdBackClick(Sender: TObject);
begin
WebBrowser1.GoBack;   //it seams that something is not working :-)
//a lot of options available to expand app
end;

procedure TfrmMain.cmdLoadClick(Sender: TObject);
begin
WebBrowser1.Navigate(txtAddress.Text);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
WebBrowser1.Silent:=True; //disable java script errors/windows...
end;

end.

Media Player with VLC ActiveX Type library Delphi tutorial (Tip for 10 )

noreply@blogger.com (kobyx) — Tue, 03 Oct 2017 20:15:00 +0000

This is an example of media player created in Delphi using VLC multimedia player ActiveX library.

For this to work VLC player and its ActiveX library must be installed.
https://www.videolan.org/vlc/

Then it is necessary to import ActiveX component in Delphi.

Detailed instruction can be seen in this video :

Fallowing is source code for this example :

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, AXVLC_TLB;

type
  TfrmMain = class(TForm)
    VLCPlugin21: TVLCPlugin2;
    ListBox1: TListBox;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    Button3: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
VLCPlugin21.playlist.stop;
VLCPlugin21.playlist.clear;
ListBox1.Items.Clear;
ListBox1.Items.AddStrings(OpenDialog1.Files);
end;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
var
fnamePr:WideString;
fname:WideString;
id:Integer;
begin
if ListBox1.SelCount<>0 then //if sellection is different than zero
begin
fnamePr:='file:///';   //For local files we have to add this in the prefix of file name
fname:=ListBox1.Items[ListBox1.ItemIndex];
fname:=StringReplace(fname,'/','\\',[rfReplaceAll]) ;//we have to replace right
//slashes with two left
fname:=fnamePr+fname; //combine these to strings to file name
Label1.Caption:=fname;
VLCPlugin21.playlist.stop; //stop playback
VLCPlugin21.playlist.clear;//clear playlist.You don't need to do this, you can just
//add new files to the playlist.
//For the sake of simplicity I am doing this way.
id:=VLCPlugin21.playlist.add(PChar(fname),null,null);
VLCPlugin21.playlist.playItem(id);
end;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
var id:Integer;
begin
VLCPlugin21.playlist.stop;
VLCPlugin21.playlist.clear;
id:=VLCPlugin21.playlist.add(PChar(Edit1.Text),null,null);
VLCPlugin21.playlist.playItem(id);
end;

procedure TfrmMain.ListBox1DblClick(Sender: TObject);
begin
Button2.Click;
end;

end.

Music Player using BASS library Delphi tutorial (Tip for 10 )

noreply@blogger.com (kobyx) — Mon, 25 Sep 2017 21:33:00 +0000


Delphi mp3 music player

Example how to create mp3 player with Delphi and BASS library.

BASS library can be downloaded from :
http://www.un4seen.com/

In this video you can see in detail how to create such mp3 player.

And following is source code of this example.

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, bass;

type
  TfrmMain = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Stop: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure StopClick(Sender: TObject);
  private
    procedure Error(msg: string);
  public
    channel:HSTREAM;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Error(msg: string);
var
 s: string;
begin
 s := msg + #13#10 + '(Error code: ' + IntToStr(BASS_ErrorGetCode) + ')';
 MessageBox(Handle, PChar(s), nil, 0);
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
i:Integer;
begin
if OpenDialog1.Execute() then
begin
ListBox1.Items.Clear;
BASS_ChannelStop(channel);
 for I := 0 to OpenDialog1.Files.Count-1 do
 begin
 ListBox1.Items.Add(OpenDialog1.Files[i]);
 end;
end;

end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
if channel>0 then begin
BASS_StreamFree(channel);  //destroy any previous channel if exists
channel:=0;
end;
channel := BASS_StreamCreateFile(FALSE, PChar(ListBox1.Items[ListBox1.ItemIndex]), 0, 0,BASS_UNICODE);
//create the stream
BASS_ChannelPlay(channel,false); // play the stream
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
if ListBox1.ItemIndex>0 then
ListBox1.Selected[ListBox1.ItemIndex-1]:=True
else if ListBox1.ItemIndex=0 then
ListBox1.Selected[ListBox1.Items.Count-1]:=True;
Button2.Click;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
if ListBox1.ItemIndex<ListBox1.Items.Count-1 then
ListBox1.Selected[ListBox1.ItemIndex+1]:=True
else if ListBox1.ItemIndex=ListBox1.Items.Count-1 then
ListBox1.Selected[0]:=True;
Button2.Click;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 // Close BASS
 BASS_Free();
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // check the correct BASS was loaded
 if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
 begin
  MessageBox(0,'An incorrect version of BASS.DLL was loaded',nil,MB_ICONERROR);
  Halt;
 end;

 // Initialize audio - default device, 44100hz, stereo, 16 bits
 if not BASS_Init(-1, 44100, 0, Handle, nil) then
  Error('Error initializing audio!');
end;

procedure TfrmMain.StopClick(Sender: TObject);
begin
BASS_ChannelStop(channel);
end;

end.

Export sql database to Excel Delphi tutorial (Tip for 10 )

noreply@blogger.com (kobyx) — Tue, 15 Aug 2017 08:39:00 +0000

An example of exporting sql database table ( in this case sqlite table ) to MS Excel.

Link to full source : Source code

Here we use previous example which we upgrade with new function used for exporting data.

As always , here is video tutorial to watch, following with full source of this example.

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ZAbstractRODataset, ZAbstractDataset,
  ZDataset, ZAbstractConnection, ZConnection, ComObj, ExcelXP, ComCtrls;

type
  TfrmMain = class(TForm)
    ZConn: TZConnection;
    ZQuery1: TZQuery;
    ZQuery2: TZQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    Edit2: TEdit;
    Button3: TButton;
    Label5: TLabel;
    Edit3: TEdit;
    Label6: TLabel;
    Edit4: TEdit;
    Button4: TButton;
    Button5: TButton;
    Label7: TLabel;
    Label8: TLabel;
    Button6: TButton;
    ProgressBar1: TProgressBar;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);

    procedure ExportTableToExcel(Tablex:TZQuery;sFile:string);
    procedure FormCreate(Sender: TObject);
    procedure Button6Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.ExportTableToExcel(Tablex:TZQuery;sFile:string);
var
//Declarations
 ExcelApplication : variant;
 Sheet : variant;
 column, row ,rowsno: integer;
 FormatFloatY:WideString;
 ValXX:WideString;
begin
Cursor:=crHourGlass;
 try   //Try to create Excel application
  begin
   ExcelApplication := CreateOleObject('Excel.Application');
   ExcelApplication.Visible := true;  //let's make visible
  end;
 except
 //If failed then show warning
  Showmessage('Cannot create an Excel file,'
  +'make sure that MS Excel is installed on your system');
  Application.Terminate;
 end;

 rowsno:=Tablex.RecordCount;   //records number in a table
 Tablex.RecNo:=1; //set table to first record
 ExcelApplication.WorkBooks.Add(-4167);   //Add excel workbook
 ExcelApplication.WorkBooks[1].WorkSheets[1].Name := 'my data';
 Sheet := ExcelApplication.WorkBooks[1].WorkSheets['my data'];

 //Format cells in excel sheet
 Sheet.Range['A1:C'+IntToStr(rowsno+1)].Borders.LineStyle := 7;
 Sheet.Range['A1:C'+IntToStr(rowsno+1)].Borders.color := clblue;

Sheet.Range['B2:B'+IntToStr(rowsno+1)].HorizontalAlignment :=xlLeft;
      //colors of cells in first line
Sheet.Cells[1,1].Interior.Color := clMoneyGreen;
Sheet.Cells[1,2].Interior.Color := clMoneyGreen;
Sheet.Cells[1,3].Interior.Color := clMoneyGreen;
                          //widths of columns
Sheet.Columns[1].ColumnWidth := 30;
Sheet.Columns[2].ColumnWidth := 30;
Sheet.Columns[3].ColumnWidth := 30;
            //captions/text of cells
Sheet.Cells[1,1] := 'ID';
Sheet.Cells[1,2] := 'NAME';
Sheet.Cells[1,3] := 'SURNAME';

   //set progressbar max value = teble records count
ProgressBar1.max:=Tablex.RecordCount;
ProgressBar1.position:=0;  //set position to 0=start
//now copy from table to excel cells
for row := 1 to Tablex.RecordCount do
begin
Sheet.Cells[row+1,1] := Tablex.Fields[0].AsString; //row+1 = move to the next line
//in column one
Sheet.Cells[row+1,2] :=Tablex.Fields[1].AsString;
//row+1 = move to the next line
//in column two
Sheet.Cells[row+1,3] := Tablex.Fields[2].AsString;
//row+1 = move to the next line
//in column three
ProgressBar1.position:=row;//set progress bar position
Tablex.Next;  //go to the next record in a table
end;
Screen.Cursor:=crDefault;  //set default cursor
ProgressBar1.position:=0; //it is done , set PB to the begining
DeleteFile(sFile);  //
Sheet.SaveAs(sFile);   //Save excel file

{
  ExcelApplication.Quit; //Quit excel
  ExcelApplication := Unassigned;  //to be sure that no hidden excel in memory
  Sheet := Unassigned;
}
    //let's close manually
Screen.Cursor:=crDefault;  //set default cursor

//let's test

//a bit slow while screen capturing
end;


procedure TfrmMain.FormCreate(Sender: TObject);
begin
SaveDialog1.InitialDir:=ExtractFilePath(Application.ExeName);
end;

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;

ComboBox1.Items.Clear;
ZConn.GetTableNames('',ComboBox1.Items);
ComboBox1.ItemIndex:=0;
ComboBox1.OnChange(Self);
end;

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.Button6Click(Sender: TObject);
begin
if SaveDialog1.Execute() then
begin
ExportTableToExcel(ZQuery2,SaveDialog1.FileName);
end;
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;

end.

Video Player using Direct Show DSPack component for Delphi (Tip for 10 )

noreply@blogger.com (kobyx) — Tue, 09 May 2017 21:18:00 +0000

- Example of media player created with Delphi and DSPack components.

- You can download component from: https://github.com/ms301/dspack

- You should also download ffdshow from the following location :
https://sourceforge.net/projects/ffdshow-tryout/?source=directory

- Detailed procedure of video player creation is shown in the following video :

- Also full source code is listed below :

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, DSPack, ExtCtrls, StdCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Open: TButton;
    Stop: TButton;
    Play: TButton;
    Pause: TButton;
    Timer1: TTimer;
    OPD: TOpenDialog;
    FilterGraph1: TFilterGraph;
    VideoW: TDSVideoWindowEx2;
    PBar: TProgressBar;
    procedure OpenClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
    procedure PauseClick(Sender: TObject);
    procedure PlayClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PBarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  PBDown:Boolean=False;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
OPD.InitialDir:=ExtractFilePath(Application.ExeName);
FilterGraph1.Active:=True;
end;

procedure TfrmMain.OpenClick(Sender: TObject);
begin
if OPD.Execute() then
begin

Timer1.Enabled:=False;
FilterGraph1.ClearGraph;
FilterGraph1.Stop;
FilterGraph1.RenderFile(OPD.FileName);
PBar.Max:=FilterGraph1.Duration;
FilterGraph1.Play;
Timer1.Enabled:=True;
end;
end;

procedure TfrmMain.PauseClick(Sender: TObject);
begin
FilterGraph1.Pause;
Timer1.Enabled:=False;
end;

procedure TfrmMain.PBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
PBDown:=True;
end;

procedure TfrmMain.PBarMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  Ratio:Real;
  Total:Integer;
  Position:Integer;
begin
if PBDown=true then
begin
Ratio:=X/PBar.ClientWidth;
Total:=Round(PBar.Max-Pbar.Min);
Position:=Round((Total*Ratio)+Round(PBar.Min));
PBar.Position:=Position;
FilterGraph1.Position:=Round(PBar.Position);
PBDown:=False;
end;
end;

procedure TfrmMain.PlayClick(Sender: TObject);
begin
FilterGraph1.Play;
Timer1.Enabled:=True;
end;

procedure TfrmMain.StopClick(Sender: TObject);
begin
FilterGraph1.Stop;
FilterGraph1.ClearGraph;
PBar.Position:=0;
Timer1.Enabled:=False;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
PBar.Position:=FilterGraph1.Position;
end;

end.

VirtualStringTree as Grid - Delphi tutorial (Tip for 10 )

noreply@blogger.com (kobyx) — Mon, 17 Apr 2017 19:47:00 +0000

In this example you can learn how to use Virtualstringtree from GemSoft as a Grid.

This component can be used as a regular tree view but also as string grid,so it can replace regular stringgrid and dbgrid, but with much higher speed.
Not to mention customization.

Virtualstringtree is known for its speed, so adding 1000 or 10000 nodes takes a bit of a second.

In this tutorial you can learn how to variable columns and rows number, meaning to use variable data that should be shown, for example database table records etc.

Full source for this example can be found below

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, VirtualTrees;

type
  TfrmMain = class(TForm)
    VST: TVirtualStringTree;
    txtColNumb: TEdit;
    txtRowNumb: TEdit;
    chkAddAsNew: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    cmdAddData: TButton;

    procedure VSTColumnsCreate;
    procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure cmdAddDataClick(Sender: TObject);

  private
    { Private declarations }
  public
  ColNumb,RowNumb:Integer;

  type
  PMyRec=^TMyRec;
  TstrArr=array of string;
  TMyRec=packed record
  ArrOfStr:TstrArr;
  end;

  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.cmdAddDataClick(Sender: TObject);
var
node:PVirtualNode;
MyRecord:PMyRec;
i,j:Integer;
begin
if StrToInt(txtColNumb.Text)=0 then  begin
VST.Clear;
Exit;
end;

ColNumb:=StrToInt(txtColNumb.Text);
RowNumb:=StrToInt(txtRowNumb.Text);

VSTColumnsCreate;

if chkAddAsNew.Checked=true then   VST.Clear;

for j := 1 to RowNumb do begin
  node:=VST.AddChild(nil);
  MyRecord:=VST.GetNodeData(node);
  SetLength(MyRecord.ArrOfStr,ColNumb);
  for i:=0 to ColNumb-1 do
  MyRecord.ArrOfStr[i]:='Field '+IntToStr(j)+':'+IntToStr(i);

end;
VST.EndUpdate;

end;

procedure TfrmMain.VSTColumnsCreate;
var i:Integer;
begin
VST.BeginUpdate;
with VST.Header do begin
  Columns.Clear;
  for i := 0 to ColNumb-1 do  begin
    Columns.Add;
    Columns[i].Width:=100;
    Columns[i].Text:='Column '+IntToStr(i);
  end;

end;
VST.EndUpdate;
end;

procedure TfrmMain.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
  var
  MyRecord:PMyRec;
  i:Integer;
begin
MyRecord:=Sender.GetNodeData(Node);
for i := 0 to ColNumb-1 do begin

  if ( Column=i) then CellText:=MyRecord.ArrOfStr[i];

end;
end;

end.

Form in a DLL file Delphi tutorials (Tip for 10 )

noreply@blogger.com (kobyx) — Thu, 02 Feb 2017 19:19:00 +0000

In this example you can see how to create dll file with form in it , and call this form from host application.

Following is the source code :

(code style formatted by http://hilite.me/ )

FormInDLL.dpr

library FormInDLL;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  FastMM4,
  FastShareMem,
  SysUtils,
  Classes,
  Windows,
  Controls,
  Forms,
  formDLL in 'formDLL.pas' {DllForm};

{$R *.res}
procedure Create_Form(pn:HWND);
begin
DllForm:=TDllForm.CreateParented(pn);
DllForm.BorderStyle:=bsNone;
DllForm.Show;
end;

procedure Size_Form(pnh,pnw:integer);
begin
DllForm.Height:=pnh;
DllForm.Width:=pnw;
end;

exports
Create_Form, Size_Form;

begin
end.

formDLL.pas

unit formDLL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg, pngimage, GifImage;

type
  TDllForm = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Image1: TImage;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DllForm: TDllForm;

implementation

{$R *.dfm}

procedure TDllForm.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
end;
end;

procedure TDllForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

end.


Host Application :

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    DLLFormCreated:Boolean;
  public
    { Public declarations }
  end;
procedure Create_Form(pn:HWND); external 'FormInDLL.dll' name 'Create_Form';
procedure Size_Form(pnh,pnw:integer); external 'FormInDLL.dll' name 'Size_Form';

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
Create_Form(Panel1.Handle); // call procedure in DLL, create DLL form in Panel
Size_Form(Panel1.Height,Panel1.Width);// call procedure in DLL
DLLFormCreated:=True;
Button1.Hide;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
DLLFormCreated:=False;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
if DLLFormCreated=True then
 Size_Form(Panel1.Height,Panel1.Width);// call procedure in DLL
end;

end.

Media Player - Delphi tutorial (Tip for 10 )

noreply@blogger.com (kobyx) — Fri, 30 Dec 2016 15:28:00 +0000

Delphi example showing how to create Media Player.
Here you can see how to create Media Player with which you can play music and video files.
It is quite simple and easy way to do this with Delphi.

Following is the source code of this example :

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MPlayer, ExtCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    MediaPlayer1: TMediaPlayer;
    ScrollBar1: TScrollBar;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel2Resize(Sender: TObject);
    procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName);
if OpenDialog1.Execute then
begin

Timer1.Enabled:=False;
 MediaPlayer1.FileName:=OpenDialog1.FileName;
 MediaPlayer1.Open;
 MediaPlayer1.Display:=Panel2;
 MediaPlayer1.DisplayRect:=Panel2.ClientRect;
 ScrollBar1.Max:=MediaPlayer1.TrackLength[1];
 Timer1.Enabled:=True;
end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
Label1.Parent:=ScrollBar1;
Label1.Left:=Round(ScrollBar1.Width/2);
Label1.Top:=0;
end;

procedure TfrmMain.Panel2Resize(Sender: TObject);
begin
MediaPlayer1.DisplayRect:=Panel2.ClientRect;
Label1.Left:=Round(ScrollBar1.Width/2);
Label1.Top:=0;
end;

procedure TfrmMain.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
MediaPlayer1.Position:=ScrollBar1.Position;
MediaPlayer1.Play;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
ScrollBar1.Position:=MediaPlayer1.Position;
Label1.Caption:=FormatFloat('0#.##',(ScrollBar1.Position/ScrollBar1.Max)*100)+' %';
if MediaPlayer1.Position=ScrollBar1.Max then MediaPlayer1.Stop;

end;

end.

Delphi tutorial - Tabbed interface (Tip for 10 )

noreply@blogger.com (Unknown) — Sun, 18 Dec 2016 19:18:00 +0000

Delphi example showing how to create tabbed interface.

Here you can see how to dynamically create Memo and Picture and put them in Active sheet ( active tab ).

Also some actions with tabs, add, edit caption, move, delete ...

In following video you can see whole process of creating this example :

Following is full source code and also picture and icon used in the example:

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ImgList, ExtCtrls, jpeg;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Button5: TButton;
    PageControl1: TPageControl;
    ImageList1: TImageList;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  TbPg:TTabSheet;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
if PageControl1.PageCount=0  then Exit;
PageControl1.ActivePage.Free;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
TbPg:=TTabSheet.Create(PageControl1);
TbPg.PageControl:=PageControl1;
TbPg.ImageIndex:=0;
TbPg.Caption:='Tab '+IntToStr(PageControl1.PageCount);
PageControl1.ActivePage:=TbPg;
PageControl1.TabWidth:=150;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
var
memx:TMemo;
begin
if PageControl1.PageCount=0  then Exit;
memx:=TMemo.Create(PageControl1.ActivePage);
memx.Parent:=PageControl1.ActivePage;
memx.Align:=alClient;
memx.Lines.Add('Created in '+PageControl1.ActivePage.Caption);
end;

procedure TfrmMain.Button4Click(Sender: TObject);
var
imgx:TImage;
begin
if PageControl1.PageCount=0  then Exit;
imgx:=TImage.Create(PageControl1.ActivePage);
imgx.Parent:=PageControl1.ActivePage;
imgx.Align:=alClient;
imgx.Proportional:=True;
imgx.Picture.LoadFromFile('flower.jpg');// picture prepared earlier in app folder
end;

procedure TfrmMain.Button5Click(Sender: TObject);
begin
if PageControl1.PageCount=0  then Exit;
PageControl1.ActivePage.Caption:=Edit1.Text;
end;

procedure TfrmMain.PageControl1Change(Sender: TObject);
begin
frmMain.Caption:=PageControl1.ActivePage.Caption;
end;

procedure TfrmMain.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
const
TCM_GETITEMRECT = $130A  ;
var
i:Integer;
r:TRect;
begin
//let's try to drag / move tabs
if not ( Sender is TPageControl ) then Exit;

 with PageControl1 do begin
   for i := 0 to PageCount-1 do begin

     Perform(TCM_GETITEMRECT,i,lParam(@r)) ;
     if PtInRect(r,Point(X,Y)) then begin
     if i<> ActivePage.PageIndex then ActivePage.PageIndex:=i;
     OnChange(Self);
     Exit;
     end;
   end;
 end;

end;

procedure TfrmMain.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
if Sender is TPageControl then  Accept:=True;

end;

procedure TfrmMain.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
PageControl1.BeginDrag(False);
end;

end.

Delphi tutorial - Use external fonts (Tip for 10 )

noreply@blogger.com (Unknown) — Fri, 02 Dec 2016 21:36:00 +0000

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.

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    UpDown1: TUpDown;
    FontDialog1: TFontDialog;
    procedure Edit2Change(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
   pthx:WideString;
  end;

var
  Form2: TForm2;
  Strl:TStringList;

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;

end.

Delphi tutorial connect SQLite with ZEOS library

noreply@blogger.com (Unknown) — Mon, 14 Nov 2016 20:16:00 +0000

For this app to create you will need "sqlite3.dll" file which you can download from : https://sqlite.org/

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.

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, ZAbstractRODataset, ZAbstractDataset,
ZDataset, ZAbstractConnection, ZConnection;

type
TfrmMain = class(TForm)
ZConn: TZConnection;
ZQuery1: TZQuery;
ZQuery2: TZQuery;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
Button2: TButton;
ComboBox1: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Label4: TLabel;
Edit2: TEdit;
Button3: TButton;
Label5: TLabel;
Edit3: TEdit;
Label6: TLabel;
Edit4: TEdit;
Button4: TButton;
Button5: TButton;
Label7: TLabel;
Label8: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure DBGrid1CellClick(Column: TColumn);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}


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;

ComboBox1.Items.Clear;
ZConn.GetTableNames('',ComboBox1.Items);
ComboBox1.ItemIndex:=0;
ComboBox1.OnChange(Self);
end;

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;

end.

Delphi tutorial – connect MySQL with ZEOS library

noreply@blogger.com (Unknown) — Thu, 20 Oct 2016 18:11:00 +0000

Delphi tutorial – connect MySQL with ZEOS library

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.

Code:

(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ZAbstractRODataset, ZAbstractDataset, ZDataset,
  ZAbstractConnection, ZConnection, ComCtrls, StdCtrls, Grids, DBGrids;

type
  TfrmMain = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    txtHost: TEdit;
    txtPort: TEdit;
    txtUser: TEdit;
    Label4: TLabel;
    txtPass: TEdit;
    Button1: TButton;
    Button2: TButton;
    StatusBar1: TStatusBar;
    ZConnection1: TZConnection;
    ZQuery1: TZQuery;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label5: TLabel;
    txtDBName: TEdit;
    Button3: TButton;
    cboDatabases: TComboBox;
    cmdDelDB: TButton;
    cmdConnectDB: TButton;
    GroupBox4: TGroupBox;
    cboTables: TComboBox;
    cmdDelTable: TButton;
    cmdOpenTable: TButton;
    Label6: TLabel;
    Button4: TButton;
    txtNewTable: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    txtName: TEdit;
    txtSurname: TEdit;
    Button5: TButton;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ZConnection1AfterConnect(Sender: TObject);
    procedure ZConnection1AfterDisconnect(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure cmdDelDBClick(Sender: TObject);
    procedure cmdConnectDBClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdOpenTableClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure cmdDelTableClick(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

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;

cboTables.Items.Clear;
ZConnection1.GetTableNames('',cboTables.Items);
cboTables.ItemIndex:=0;
end;


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;

end.

//end code

Tutorial by Kobyx Kitchen bar

noreply@blogger.com (Unknown) — Sun, 25 Sep 2016 11:27:00 +0000

Tutorial by Kobyx Kitchen bar

Tutorial on creating kitchen bar by yourself.

Delphi tutorial MS Access database with KADao

noreply@blogger.com (Unknown) — Sat, 24 Sep 2016 11:04:00 +0000

Delphi tutorial MS Access database with KADao

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

Here is the video :

Source code for this app example :

(code style formatted by http://hilite.me/ )

unit MainForm

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, KDaoTable, KDaoDataBase, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
lbTblName: TLabel;
Label2: TLabel;
ComboBox1: TComboBox;
Edit1: TEdit;
Label3: TLabel;
Label4: TLabel;
Edit2: TEdit;
Label5: TLabel;
Edit3: TEdit;
Button5: TButton;
Button6: TButton;
Database1: TKADaoDatabase;
Table1: TKADaoTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button7: TButton;
lbDbName: TLabel;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
SaveDialog1.InitialDir:=ExtractFilePath(Application.ExeName) ;
if SaveDialog1.Execute() then
begin

Database1.Close;
Database1.CreateAccessDatabase(SaveDialog1.FileName+'.mdb');
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
TM:TKADaoTableManager;
begin
if Database1.Connected=False then Exit;
try
Database1.Connected:=true;
TM:=TKADaoTableManager.Create(Database1);
TM.TableName:=InputBox('Insert table name','Table name','Table 1');
TM.FieldDefs.Add('Field 1',ftInteger,0,False);
TM.FieldDefs.Add('Field 2',ftString,100,False);
TM.FieldDefs.Add('Field 3',ftDate,0,False);
TM.IndexDefs.Add('Field 1','Field 1',[ixPrimary,ixUnique]);
TM.IndexDefs.Add('Field 2','Field 2',[]);
TM.CreateTable;
lbTblName.Caption:=TM.TableName;
TM.Free;

Database1.Connected:=False;
Database1.Open;
ComboBox1.Items.Clear;
ComboBox1.Items.AddStrings(Database1.TableNames);
ComboBox1.ItemIndex:=0;


except
ShowMessage('Error creating table');
end;
end;

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;

DBGrid1.Columns[0].Width:=100;
DBGrid1.Columns[1].Width:=200;
DBGrid1.Columns[2].Width:=100;

end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if (Edit1.Text<>'') then begin

Table1.Insert;
Table1.Append;
Table1.FieldByName('Field 1').AsInteger:=StrToInt(Edit1.Text);
Table1.FieldByName('Field 2').AsString:=Edit2.Text;
Table1.FieldByName('Field 3').AsDateTime:=StrToDate(Edit3.Text);
Table1.Post;

end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
Table1.Edit;
Table1.UpdateRecord;
Table1.Post;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
Table1.Delete;
end;

end.

Delphi and other DIY

stm32g030 read analog PA0 and PA3 code with STM32CubeID

Amazing Home automation system with STM32F103 microcontroller Part 1

Amazing Home automation system with STM32F103 microcontroller

DIY method of making PCB using toner transfer method

This is a DIY method of making PCB using toner transfer method.

The most important thing is to have good print , done with good quality toner. Here we use some dangerous chemicals so be very careful if you going to do this at home.Please check following video for details, and I will show you also few steps in following points.

Etching PCB with HCL and hydrogen peroxide

This is a DIY method of making PCB using HCL and hydrogen peroxide .

The most important thing is to have good print , done with good quality toner. Here we use some dangerous chemicals so be very careful if you going to do this at home. Please check following video for details, and I will show you also few steps in following points.

Compress files and folders to zip file with Delphi (Tip for 10 )

This is an example of zipping ( compressing ) files and folders with Delphi using "FWZip" component which can be downloaded from following link :

Export Image To PDF with Delphi (Tip for 10 )

This is example how one can export image from Delphi application to PDF file, using open source library SynPDF.

Draw shapes with Delphi (Tip for 10 )

LAB power supply with current control (Tip for 10 )

Get Base File Info (Tip for 10 )

LM317 Variable power supply with current control (Tip for 10 )

Get Computer Drives - Delphi Tutorial (Tip for 10 )

Web browser Delphi Example (Tip for 10 )

Media Player with VLC ActiveX Type library Delphi tutorial (Tip for 10 )

Music Player using BASS library Delphi tutorial (Tip for 10 )

Export sql database to Excel Delphi tutorial (Tip for 10 )

Video Player using Direct Show DSPack component for Delphi (Tip for 10 )

VirtualStringTree as Grid - Delphi tutorial (Tip for 10 )

Form in a DLL file Delphi tutorials (Tip for 10 )

Media Player - Delphi tutorial (Tip for 10 )

Delphi tutorial - Tabbed interface (Tip for 10 )

Delphi tutorial - Use external fonts (Tip for 10 )

Delphi tutorial connect SQLite with ZEOS library

Delphi tutorial – connect MySQL with ZEOS library

Delphi tutorial – connect MySQL with ZEOS library

Tutorial by Kobyx Kitchen bar

Delphi tutorial MS Access database with KADao

The most important thing is to have good print , done with good quality toner.
Here we use some dangerous chemicals so be very careful if you going to do this at home.
Please check following video for details, and I will show you also few steps in following points.

The most important thing is to have good print , done with good quality toner.
Here we use some dangerous chemicals so be very careful if you going to do this at home.
Please check following video for details, and I will show you also few steps in following points.