Example Delphi

Take a Property Value From Many Object with As Operator

admin — Fri, 01 Aug 2008 10:53:36 +0000

 
//This is how we can Take a property value from many Object with As Operator
// Form this example we need 5 RadioButton1 to RadioButton5(TRadioButton) placed on Form1
//The we make GetRadioButtonCaption Function to be called by clicking each of RadioButton
//On Click event of each TRadioButton call this GetRadioButtonCaption Function
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function GetRadioButtonCaption(Sender: TObject):String;
begin
  Result :=(Sender as TRadioButton).Caption;
end;
 
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  Showmessage(GetRadioButtonCaption(Sender));
end;
 
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
 Showmessage(GetRadioButtonCaption(Sender));
end;
 
procedure TForm1.RadioButton3Click(Sender: TObject);
begin
  Showmessage(GetRadioButtonCaption(Sender));
end;
 
procedure TForm1.RadioButton4Click(Sender: TObject);
begin
  Showmessage(GetRadioButtonCaption(Sender));
end;
 
procedure TForm1.RadioButton5Click(Sender: TObject);
begin
  Showmessage(GetRadioButtonCaption(Sender));
end;
 
end.

Other Examples

Open A Password Protected Access Database with TOpenDialog

admin — Fri, 13 Jun 2008 03:34:05 +0000

//This is how we can open a password protected access database with TOpenDialog
//For this example we need Button1 and Button2 (TButton), Edit1 and Edit2 (TEdit) and also AdoConnection1 (TAdoConnection)
//Button1 is used to open access database file
//Edit2 is used for access database password
//Button2 is used to open connection
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    ADOConnection1: TADOConnection;
    Edit2: TEdit;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Edit1.Text := OpenDialog1.FileName;
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
    ADOConnection1.Close;
    ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data ' +
      'Source='+Edit1.Text+';Mode=ReadWrite;Persist ' +
      'Security Info=False;Jet OLEDB:Database Password='+Edit2.Text;
    Edit1.Text := OpenDialog1.FileName;
    try
      ADOConnection1.Open;
      if ADOConnection1.Connected = true then
        showmessage('Connected Sccessfull to '+Edit1.Text);
    except
      showmessage('Connection to '+Edit1.Text+' failed');
    end
end;
 
end.

Related Examples

Bitmap Operation for JPEG or JPG Image

admin — Mon, 12 May 2008 06:51:14 +0000

//This is how we can operate any Bitmap Operation to our JPEG image
//To make a bitmap operation in JPEG Image, first we need to convert JPEG Image to bitmap
//Then run any bitmap operation on convert result bitmap
//Then assign JPEG result from operated bitmap
//For this example we use convert to grayscale bitmap operation
//Use Button1(TButton) and OpenDialog1(TOpenDialog) for this example
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  jpeg;
 
{$R *.dfm}
 
function ConvertBitmapToGrayscale(const Bitmap: TBitmap): TBitmap;
var
  i, j: Integer;
  Grayshade, Red, Green, Blue: Byte;
  PixelColor: Longint;
begin
  with Bitmap do
    for i := 0 to Width - 1 do
      for j := 0 to Height - 1 do
      begin
        PixelColor := ColorToRGB(Canvas.Pixels[i, j]);
        Red        := PixelColor;
        Green      := PixelColor shr 8;
        Blue       := PixelColor shr 16;
        Grayshade  := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
        Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade);
      end;
  Result := Bitmap;
end;
 
procedure ConvertToBitmap(Source : TGraphic; Bitmap : TBitmap);
begin
 try
  if Bitmap = nil then
    Bitmap := TBitmap.Create
  else Bitmap.FreeImage;
  Bitmap.Width := Source.Width;
  Bitmap.Height := Source.Height;
  Bitmap.Canvas.Draw(0,0,Source);
 except
   showmessage('No Loaded File');
 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  MyJpeg,OperatedJpeg:TJPEGImage;
  MyBitmap,OperatedBitmap:TBitmap;
begin
  if OpenDialog1.Execute then
  begin
    MyJpeg        := TJPEGImage.Create;
    MyBitmap      := TBitmap.Create;
    OperatedBitmap := TBitmap.Create;
    OperatedJpeg   :=  TJPEGImage.Create;
    try
      MyJpeg.LoadFromFile(OpenDialog1.FileName);
      ConvertToBitmap(MyJpeg,MyBitmap);
      // Do any Bitmap Operation Here
      //For Example i Convert Bitmap To GrayScale and perform result into
      //operateBitmap
      OperatedBitmap := ConvertBitmapToGrayscale(MyBitmap);
      //Perform operated bitmap into jpeg
      OperatedJpeg.Assign(OperatedBitmap);
      OperatedJpeg.SaveToFile(OpenDialog1.FileName+'-Gray.jpeg');
      Showmessage('Operation Completed')
    finally
      MyJpeg.Free;
      OperatedJpeg.Free;
    end;
  end;
end;
 
end.

Related Examples

Play a Wav Sound Without TMediaPlayer

admin — Wed, 07 May 2008 09:51:25 +0000

//This is we can play a WAV file without TMediaPlayer Component
//Using PlaySound Function declared in mmsystem unit
//So you must add mmsystem in uses clause
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, MPlayer, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  mmsystem;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   PlaySound(PChar('C:\WINDOWS\Media\Windows XP Startup.wav'),0,SND_ASYNC)
end;
 
end.

Other Examples

Delete a Directory

admin — Tue, 06 May 2008 11:52:49 +0000

//This is how we can delete a directory
//DelDir Function originally wrote by Rainer Kümmerle (http://www.thinklazy.de)
//Put a Button1(Tbutton) then use this code
//Make a directory named 'DeletedDir' in your application path to be tested
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  ShellApi;
 
function DelDir(dir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_DELETE;
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
    pFrom  := PChar(dir + #0);
  end;
  Result := (0 = ShFileOperation(fos));
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(ExtractFilePath(Application.ExeName)+'DeletedDir');
  if DelDir(ExtractFilePath(Application.ExeName)+'DeletedDir')=true then
    ShowMessage(ExtractFilePath(Application.ExeName)+'DeletedDir'+' ' +
      'succesfully deleted')
  else
    ShowMessage('Delete Failed');
end;
 
end.

Related Examples

Export Text File to Excel File

admin — Tue, 29 Apr 2008 06:25:10 +0000

//This is how to convert or export text file to Ms. Excel File
//SaveAsExcelFile function taken from Torry's Delphi Pages http://www.swissdelphicenter.ch/torry/
//Use button1 (Tbutton) in your Form1 then try this code
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    StringGridku:TStringGrid;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses
  ComObj;
 
function RefToCell(ARow, ACol: Integer): string;
begin
  Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;
 
function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
  xlWBATWorksheet = -4167;
var
  Row, Col: Integer;
  GridPrevFile: string;
  XLApp, Sheet, Data: OLEVariant;
  i, j: Integer;
begin
  // Prepare Data
  Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
  for i := 0 to AGrid.ColCount - 1 do
    for j := 0 to AGrid.RowCount - 1 do
      Data[j + 1, i + 1] := AGrid.Cells[i, j];
  // Create Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := False;
    // Add new Workbook
    XLApp.Workbooks.Add(xlWBatWorkSheet);
    Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet.Name := ASheetName;
    // Fill up the sheet
    Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
      AGrid.ColCount)].Value := Data;
    // Save Excel Worksheet
    try
      XLApp.Workbooks[1].SaveAs(AFileName);
      Result := True;
    except
      // Error ?
    end;
  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  StringListKu:TStrings;
  i:integer;
begin
  StringGridku := TStringGrid.Create(self);
  StringListKu := TStringList.Create;
  try
    if OpenDialog1.Execute then
    begin
      StringListKu.LoadFromFile(OpenDialog1.FileName);
      for i := 0 to StringListKu.Count - 1 do
      begin
        StringGridku.Cells[0,i] := StringListKu.Strings[i]
      end;
      if SaveAsExcelFile(StringGridku, 'Datakuuuu', 'c:\MyExcelFile.xls') then
      ShowMessage('StringGrid tersimpan di c:\MyExcelFile.xls');
    end;
  finally
    StringGridku.Free;
    StringListKu.Free;
  end;
end;
 
end.

Related Examples

Export Excel File to Text File

admin — Tue, 29 Apr 2008 06:17:39 +0000

//This is how to convert Excel file to as text file
//ExcelSaveAsText function taken from Torry's Delphi Page http://www.swissdelphicenter.ch/torry/
//Use Button1 (TButton) and try the code
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    StrExcelFile:String;
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
ComObj;
 
{$R *.dfm}
 
function ExcelSaveAsText(ExcelFile, TextFile: TFileName): Boolean;
const
  xlText = -4158;
var
  ExcelApp: OleVariant;
  vTemp1, vTemp2, vTemp3: OLEVariant;
begin
  Result := False;
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    // Fehler beim öffnen von Excel...
    // Error occured...
    Exit;
  end;
  try
    ExcelApp.Workbooks.Open(ExcelFile);
    ExcelApp.DisplayAlerts := False;
    vTemp3 := False;
    vTemp2 := xlText;
    vTemp1 := TextFile;
    ExcelApp.ActiveWorkbook.SaveAs(vTemp1, vTemp2, vTemp3);
    Result := True;
  finally
    ExcelApp.Quit;
    ExcelApp := Unassigned;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    StrExcelFile := OpenDialog1.FileName;
    ExcelSaveAsText(StrExcelFile,'C:\ExportResult.txt') ;
    Showmessage('Saved as '+StrExcelFile);
  end;
end;
 
end.

Related Examples

Search File in A Directory and Perform Result in TListBox

admin — Mon, 28 Apr 2008 02:02:39 +0000

//This is how we can search  any file in specific drive and directory by using a simple code
//Search a specific file like 'C:\Windows\zapotec.bmp'
//Search by using part of file name like '*.*' or 'filename.*' or 'partfilename*.*' or 'filename.*xe' etc
//For this example use Button1 (TButton) and ListBox (TListBox)
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  strFile :String;
begin
  strFile :='C:\Windows\*.*';
  //We can write file search string clause like '*.jpg' or 'zap*.bmp' or '*tec.*' etc
  ListBox1.Perform(LB_DIR,DDL_READONLY,LongInt(@strFile[1]));
end;
 
end.

Other Examples

Delete Row in TStringGrid Component

admin — Fri, 25 Apr 2008 12:00:01 +0000

//When we work with TStringGrid Component, There is no methode for deleting row
//This is how we can Delete row in TStringGrid Component
//Just place Button1 (TButton) and StringGrid1 (TStringGrid) on the Form1 then try this code
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
//Procedure Below to fill StringGrid1 Cells with its coordinate self
procedure TForm1.FormCreate(Sender: TObject);
var
  i,j:integer;
begin
  for i := 0 to StringGrid1.RowCount -1 do
  begin
    for j := 0 to StringGrid1.ColCount - 1 do
    begin
      StringGrid1.Cells[j,i] := IntToStr(j)+','+IntToStr(i);
    end;
  end;
end;
 
//Copy the parameterized row contains from next row
procedure DeleteStringGridRow1(AStringGrid:TStringGrid;Arow:Integer);
var
  i,j:integer;
begin
  for i := Arow to AStringGrid.RowCount - 2 do
  begin
    for j := 0 to AStringGrid.ColCount - 1 do
    begin
      AStringGrid.Cells[j,i] := AStringGrid.Cells[j,i+1];
    end;
  end;
  AStringGrid.RowCount := AStringGrid.RowCount-1;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  SelectedRow:integer;
begin
  //Click to the row you want to delete
  SelectedRow := StringGrid1.Row;
  DeleteStringGridRow1(StringGrid1,SelectedRow);
end;
 
end.

Related Examples

Export Text File to Excel File

Get Local IP Address

admin — Thu, 24 Apr 2008 07:29:17 +0000

//This is how we can get IP Address from our computer
//For this example we need Button1 (TButton) and Label1 (TLabel) placed on Form1
//Add Winsock in uses clausa
//No we can obtain local computer IP Address by clicking Button1
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winsock;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
Function GetIPAddress():String;
type
  pu_long = ^u_long;
var
  varTWSAData : TWSAData;
  varPHostEnt : PHostEnt;
  varTInAddr : TInAddr;
  namebuf : Array[0..255] of char;
begin
  If WSAStartup($101,varTWSAData) <> 0 Then
  Result := 'No. IP Address'
  Else Begin
    gethostname(namebuf,sizeof(namebuf));
    varPHostEnt := gethostbyname(namebuf);
    varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^);
    Result := 'IP Address: '+inet_ntoa(varTInAddr);
  End;
  WSACleanup;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := GetIPAddress;
end;
 
end.

Related Examples

Get Image from Server with Indy Socket