• General :

procedure TForm1.Button1Click(Sender: TObject);
begin

color:=ClRed;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin

color:=ClGreen;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin

color:=ClBlue;

end;

• Using Tag :

3 Procedures can became 1 procedure :.

Put number of Tag on each button

• Button1 –> Tag=0
• Button2 –> Tag=1
• Button3 –> Tag=2

Every Button use Button1Click(Sender: TObject);

procedure TForm1.Button1Click(Sender: TObject);
begin
with Sender as TButton do
begin
case Tag of
0: color:=ClRed;
1: color:=ClGreen;
2: color:=ClBlue;
end;
end;
end;

procedure hideTaskbar;
var
wndHandle: THandle;
wndClass: array[0..50] of Char;
begin
StrPCopy(@wndClass[0], ‘Shell_TrayWnd’);
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE); // This hides the taskbar
end;

procedure showTaskbar;
var
wndHandle: THandle;
wndClass: array[0..50] of Char;
begin
StrPCopy(@wndClass[0], ‘Shell_TrayWnd’);
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_SHOWDEFAULT); // This restores the taskbar
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
hideTaskbar;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
showTaskbar;
end;

// ************************************************************************ //
// WARNING
// ——-
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// ‘Refresh’ command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 2004-2-16 8:40:08 from Type Library described below.

// ************************************************************************ //
// Type Lib: C:\Program Files\Common Files\System\ado\msjro.dll (1)
// LIBID: {AC3B8B4C-B6CA-11D1-9F31-00C04FC29D52}
// LCID: 0
// Helpfile: C:\Program Files\Common Files\System\ado\msjro.chm
// HelpString: Microsoft Jet and Replication Objects 2.6 Library
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\System32\stdole2.tlb)
// (2) v2.7 ADODB, (C:\Program Files\Common Files\System\ado\msado15.dll)
// Errors:
// Error creating palette bitmap of (TReplica) : Server C:\Program Files\Common Files\System\ado\msjro.dll contains no icons
// Error creating palette bitmap of (TJetEngine) : Server C:\Program Files\Common Files\System\ado\msjro.dll contains no icons
// ************************************************************************ //
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, ADODB_TLB, Classes, Graphics, OleServer, StdVCL, Variants;

bla bla…..

end. jro tlb

unit UDataBaseCompact;

interface

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

procedure TForm_tool.DataBaseCompact;
Var
oJetEngine:JetEngine;
sourcefilename:String;
tempfilename:String;
soldmdb:String;
snewmdb:String;
checkfile:File;
oldsize:Int64;
newsize:Int64;
Begin
sourcefilename:=’c:\data.mdb‘;

AssignFile(checkfile,sourcefilename);
Reset(checkfile,1);
oldsize:=FileSize(checkfile);
CloseFile(checkfile);

tempfilename:=ChangeFileExt(sourcefilename,’.tmp’);
soldmdb:=’Provider=Microsoft.Jet.OLEDB.4.0;Data Source=’+sourcefilename+’;Jet OLEDB:Database Password=’+Const_DBPassword;
snewmdb:=’Provider=Microsoft.Jet.OLEDB.4.0;Data Source=’+tempfilename+’;Jet OLEDB:Database Password=’+Const_DBPassword;
Try
oJetEngine:=CoJetEngine.Create;
oJetEngine.CompactDatabase(soldmdb,snewmdb);
DeleteFile(sourcefilename);
MoveFile(PChar(tempfilename),PChar(sourcefilename));
Except
DeleteFile(tempfilename);
Self.Hide;
Application.MessageBox(’Fail to compact database’+#13#13+’1.Make sure database isn”t being used by others.’+#13#13+’2.Make sure space of hard disk is enough.’+#13#13+’3.Please try again.’,PChar(Const_AppName),MB_IconError+MB_Ok);
Close;
End;

AssignFile(checkfile,sourcefilename);
Reset(checkfile,1);
newsize:=FileSize(checkfile);
CloseFile(checkfile);
Label_After_BeforeCompactSizeDisplay.Caption:=FormatFloat(’###,###.##” KB”‘,(oldsize/1024));
Label_After_AfterCompactSizeDisplay.Caption:=FormatFloat(’###,###.##” KB”‘,(newsize/1024));
Label_After_CompactSizeDisplay.Caption:=FormatFloat(’###,###.##” KB”‘,(oldsize-newsize)/1024);

end;

procedure TForm1.Button3Click(Sender: TObject);
var

  F1, F2: TextFile;
  Ch: Char;
begin
  if OpenDialog1.Execute then begin
    AssignFile(F1, OpenDialog1.Filename);
    Reset(F1);
    if SaveDialog1.Execute then begin
      AssignFile(F2, SaveDialog1.Filename);
      Rewrite(F2);
      while not Eof(F1) do
      begin
        Read(F1, Ch);
        Write(F2, Ch);
      end;
      writeln(f2,’add new data’);
      CloseFile(F2);
    end;
    CloseFile(F1);
  end
end;

a program heading,
a uses clause (optional), and
a block of declarations and statements.

The program heading specifies a name for the program. The uses clause lists units used by the program. The block contains declarations and statements that are executed when the program runs. The IDE expects to find these three elements in a single project (.dpr) file.

The following example shows the project file for a program called Editor.

1     Program Project1;
2
3     uses
4       QForms, {cross-platform Form}
5       FrmAbout in ‘UAbout.pas’ {AboutBox},
6       FrmMain in ‘UMain.pas’ {MainForm};
7
8     {$R *.res}
9
10     begin
11       Application.Title := ‘First Project’;
12       Application.CreateForm(TMainForm, MainForm);
13       Application.Run;

14     end.

Line 1 contains the program heading. The uses clause is on lines 3 through 6. Line 8 is a compiler directive that links the project’s resource file into the program. Lines 10 through 14 contain the block of statements that are executed when the program runs. Finally, the project file, like all source files, ends with a period.

This is, in fact, a fairly typical project file. Project files are usually short, since most of a program’s logic resides in its unit files. Project files are generated and maintained automatically, and it is seldom necessary to edit them manually.

• Put adoconnection
• Set active becaome true
• Put Button
• Put Listbox as destination of table names

unit Unit1;

interface

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

type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
ADOConnection1.GetTableNames(ListBox1.Items,true);
end;

end.

When we create a new component, we can define our own bitmaps for custom components.

To create a new bitmap:

• Choose Tools|Image Editor.
• In the Image Editor dialog box, choose File|New|Component Resource File (.dcr).
• In the untitled1.dcr dialog box, right-click Contents. Choose New|Bitmap.
• In the Bitmaps Properties dialog box, change both the Width and Height to 24 pixels. Make sure VGA (16 colors) is checked. Click OK.

• Bitmap and Bitmap1 appear below Contents. Select Bitmap1, right-click, and choose Rename. Give the bitmap the same name as the class name for our new component, including the T, using all uppercase letters. For example, if we new class name is going to be TMyNewButton, name the bitmap TMYNEWBUTTON.

Note :

we must name all uppercase letters, no matter how we spell the class name in the New Component dialog box.

• Double-click TMYNEWBUTTON to display a dialog box with an empty bitmap.

• Use the color palette at the bottom of the Image Editor to design our icon.

• Choose File|Save As and give the resource file (.dcr or .res) the same base name as the unit you want the component class declared in. For example, name the resource file MyNewButton.dcr.

• Choose Component|New Component. Follow the instructions for creating a new component using the Component wizard. Make sure that the component source, MyNewButton.pas, is in the same directory as MyNewButton.dcr.

The Component wizard, for a class named TMyNewButton, names the component source, or unit, MyNewButton.pas with a default placement in the LIB directory. Click the Browse button to find the new location for the generated component unit.

Note :

If we are using a .res file for the bitmap rather than a .dcr file, then add a reference to the component source to bind the resource. For example, if our .res file is named MyNewButton.res, after ensuring that the .pas and .res are in the same directory, add the following to MyNewButton.pas below the type section:

{*R *.res}

• Choose Component|Install Component to install our component into a new or existing package. Click OK.

our new package is built and then installed. The bitmap representing our new component appears on the Component palette page we designated in the Component wizard.

There are several basic steps that you perform whenever you create a new component. These steps are described below; other examples in this document assume that you know how to perform them.

• Create a unit for the new component.
• Derive your component from an existing component type.
• Add properties,methods, and events.
• Register your component with the IDE.
• Create a bitmap for the component.
• Create a package (a special dynamic-link library) so that you can install your component in the IDE.
• Create a Help file for your component and its properties, methods, and events.

Note

Creating a Help file to instruct component users on how to use the component is optional.

When you finish, the complete component includes the following files:

A package (.BPL) or package collection (.DPC) file
A compiled package (.DCP) file
A compiled unit (.DCU) file
A palette bitmap (.DCR) file
A Help (.HLP) file

How to create a help file…..?  download this

How to make statusbar with images..?

we can draw icon on statusbar using canvas, or assign from imagelist. for this example we use imagelist, so we need 3 images to put in to imagelist : green, yellow and red.

Now ,

create new application, add button, imageslist, timer and statusbar. Add 3 images into imagelist and then double click on statusbar

• add new status panel
• Click on the second status panel
• Change the style from psText to psOwnerDraw

• on  StatusBar1DrawPanel
• Write this procedure :

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
// clear panel
StatusBar1.Canvas.Pen.Color := StatusBar1.Canvas.Brush.Color;
StatusBar1.Canvas.Rectangle(rect);
StatusBar1.Canvas.Pen.Color := clWindowText;
// draw icon and message
ImageList1.Draw(StatusBar1.Canvas, Rect.Left, Rect.Top, StatusIconIndex);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+15, Rect.Top, StatusIconIndex1);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+30, Rect.Top, StatusIconIndex2);
StatusBar1.Canvas.TextOut(Rect.left + 51, Rect.top+1, StatusText);
end;

Create procedure to send message on statusbar

procedure TForm1.showstatus(msg: string=”;  panel : Integer=0; busy: integer=0);
begin
if panel = 1 then begin
StatusText := msg;
case busy of
0:
begin
StatusIconIndex := 0;
StatusIconIndex1 := 0;
StatusIconIndex2 := 0;
end;
1:
begin
StatusIconIndex := 2;
StatusIconIndex1 := 1;
StatusIconIndex2 := 0;
end;
2:
begin
StatusIconIndex := 0;
StatusIconIndex1 :=2;
StatusIconIndex2 := 1;
end;
3:
begin
StatusIconIndex := 1;
StatusIconIndex1 := 0;
StatusIconIndex2 := 2;
end;
end;
end
else
StatusBar1.Panels[panel].Text := msg;
StatusBar1.Repaint;
end;

Complete source

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ImageList1: TImageList;
StatusBar1: TStatusBar;
Button2: TButton;
Timer1: TTimer;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
StatusBar2: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure showstatus(msg: string=”;  panel : Integer=0; busy: integer=0);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
StatusText          : String = ‘Initializing…’;
StatusIconIndex     : Integer = 0;
StatusIconIndex1     : Integer = 0;
StatusIconIndex2     : Integer = 0;
i:byte;
implementation

{$R *.dfm}

procedure TForm1.showstatus(msg: string=”;  panel : Integer=0; busy: integer=0);
begin
if panel = 1 then begin
StatusText := msg;
case busy of
0:
begin
StatusIconIndex := 0;
StatusIconIndex1 := 0;
StatusIconIndex2 := 0;
end;
1:
begin
StatusIconIndex := 2;
StatusIconIndex1 := 1;
StatusIconIndex2 := 0;
end;
2:
begin
StatusIconIndex := 0;
StatusIconIndex1 :=2;
StatusIconIndex2 := 1;
end;
3:
begin
StatusIconIndex := 1;
StatusIconIndex1 := 0;
StatusIconIndex2 := 2;
end;
end;
end
else
StatusBar1.Panels[panel].Text := msg;
StatusBar1.Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
showstatus(’Disconnect….’,1,1);
//StatusBar1.Repaint;
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
// clear panel
StatusBar1.Canvas.Pen.Color := StatusBar1.Canvas.Brush.Color;
StatusBar1.Canvas.Rectangle(rect);
StatusBar1.Canvas.Pen.Color := clWindowText;
// draw icon and message
ImageList1.Draw(StatusBar1.Canvas, Rect.Left, Rect.Top, StatusIconIndex);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+15, Rect.Top, StatusIconIndex1);
ImageList1.Draw(StatusBar1.Canvas, Rect.Left+30, Rect.Top, StatusIconIndex2);
StatusBar1.Canvas.TextOut(Rect.left + 51, Rect.top+1, StatusText);
end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin
if i>3 then i:=0;

showstatus(’Connected….’,1,i);
inc(i);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
showstatus(’Connected….’,1,0);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
showstatus(’Connected….’,1,1);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
showstatus(’Connected….’,1,2);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
showstatus(’Connected….’,1,3);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
if i>3 then i:=0;

showstatus(’Connected….’,1,i);
sleep(50);
inc(i);
end;

end.

Source download

procedure TFrmMain.checkmenu;
var i:integer;

begin
for i:=0 to FrmMain.componentcount-1 do
begin
if FrmMain.components[i] is tmenuitem then
begin
with FrmMain.components[i] as tmenuitem do
begin
if (caption=’-') then enabled:=true
else
if (caption=’Login’) then enabled:=true
else
if (caption=’Logout’) then enabled:=true
else
if (caption=’Exit’) then enabled:=true
else
enabled:=false;
end;
end;
end;
end;