Timer

unit Timers_Unit;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Exit: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

{our timer callback prototype}
procedure TimerProc(hWnd: HWND; uMsg: UINT; idEvent: UINT; Time: DWORD);stdcall;

var
  Form1: TForm1;
  DemoCounter: Integer;   // a counter to demonstrate that a timer is running

const
  EXAMPLETIMER = 1;       // a timer identifier

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  Tick: DWORD;    // holds the number of milliseconds
begin
  {get the number of milliseconds since Windows was started}
  Tick:= GetTickCount;

  {display the number of milliseconds}
  Label1.Caption := 'Number of Milliseconds: ' + IntToStr(Tick);
  Label2.Caption := '';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  {reset our counter}
  DemoCounter:= 0;

  {create a timer to fire once per second}
  SetTimer(Form1.Handle, // handle of window for timer messages
           EXAMPLETIMER, // timer identifier
           1000,        // fire every 1000 milliseconds
           @TimerProc        // address of timer procedure
           );
end;

{this function is run every time EXAMPLETIMER fires}
procedure TimerProc(hWnd: HWND; uMsg: UINT; idEvent: UINT; Time: DWORD);
begin
  {display a message to show that the timer is running}
  Form1.Label1.Caption := 'Timer1 is Now Running: ' + IntToStr(DemoCounter);
  Form1.Label2.Caption := '';

  {increment a counter to show that the timer is running}
  Inc(DemoCounter);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  {remove our example timer}
  KillTimer(Form1.Handle, // handle of window that installed timer
            EXAMPLETIMER   // timer identifier
            );

   {clear the caption}
   Label1.Caption := '';
   Label2.Caption := '';
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  PerformanceCount: TLargeInteger;
begin
  {if there is a high resolution performance counter in the hardware...}
  if QueryPerformanceCounter(PerformanceCount) then
    begin
      {...display its current counter...}
     // Label1.Caption := 'Performance Counter Present';
      //Label2.Caption := FloatToStr(PerformanceCount.QuadPart);
    end
  else
    begin
      {...or display a message}
     // Label1.Caption := 'Performance Counter Not Present';
     // Label2.Caption := '';
    end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  PerformanceFrequency: TLargeInteger;
begin
  {if there is a high resolution performance counter in the hardware...}
  if QueryPerformanceFrequency(PerformanceFrequency) then
    begin
      {...display its frequency...}
    //  Label1.Caption := 'Performance Frequency Present';
    //  Label2.Caption := FloatToStr(PerformanceFrequency.QuadPart);
    end
  else
    begin
      {...or display a message}
   //   Label1.Caption := 'Performance Frequency Not Present';
    //  Label2.Caption := '';
    end;
end;

procedure TForm1.ExitClick(Sender: TObject);
begin
  Form1.Close;
end;


end.

Draw in canvas

Source Code :

unit Mouse_Event_Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Panel2: TPanel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MouseButtonIsDown: boolean;   // indicates if the mouse button is down

implementation

{$R *.DFM}

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {if the mouse button is down, draw a line}
  if MouseButtonIsDown then
    Image1.Canvas.LineTo(X,Y);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {if the mouse button is not down, move the initial drawing position}
  if not MouseButtonIsDown then
    Image1.Canvas.MoveTo(X,Y);

  {indicate that the mouse button is down so that drawing will occur}
  MouseButtonIsDown := TRUE;

  {if the right mouse button was clicked...}
  if Button = MBRight then
  begin
    {...while the mouse button is held down...}
    while MouseButtonIsDown = TRUE do
    begin
      {...simulate mouse movement by the specified amounts. the image
       continues to receive regular mouse messages as if the mouse was
       under user control}
      Mouse_Event(MOUSEEVENTF_MOVE,SpinEdit1.Value,SpinEdit2.Value,0,0);

      {update the screen and pause for a short amount of time}
      Application.ProcessMessages;
      Sleep(10);
    end;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {set the mouse button down variable to off}
  MouseButtonIsDown := FALSE;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {initialize the initial drawing position}
  Image1.Canvas.MoveTo(10,10);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {initialize the mouse button down variable}
  MouseButtonIsDown := FALSE;
end;

end.

Create MDI Windows

unit CreateMDIWindowU;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    CreateChild1: TMenuItem;
    procedure CreateChild1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ Register the MDI Child Window Class }
function RegisterClass: Boolean;
var
  WindowClass: TWndClass;
begin
  {setup our new window class}
  WindowClass.Style := CS_HREDRAW or CS_VREDRAW;           {set the class styles}
  WindowClass.lpfnWndProc := @DefMDIChildProc;             {point to the default MDI child window procedure}
  WindowClass.cbClsExtra := 0;                             {no extra class memory}
  WindowClass.cbWndExtra := 0;                             {no extra window memory}
  WindowClass.hInstance := hInstance;                      {the application instance}
  WindowClass.hIcon := LoadIcon(0, IDI_WINLOGO);           {load a predefined logo}
  WindowClass.hCursor := LoadCursor(0, IDC_APPSTARTING);   {load a predefined cursor}
  WindowClass.hbrBackground := COLOR_WINDOW;               {use a predefined color}
  WindowClass.lpszMenuName := nil;                         {no menu}
  WindowClass.lpszClassName := 'TestClass';                {the registered class name}

  {now that we have our class set up, register it with the system}
  Result := Windows.RegisterClass(WindowClass) <> 0;
end;

procedure TForm1.CreateChild1Click(Sender: TObject);
var
  hWindow: HWND;
begin
  {register our new class first}
  if not RegisterClass then
  begin
    ShowMessage('RegisterClass failed');
    Exit;
  end;

  {now, create a window based on our new class}
  hWindow := CreateMDIWindow('TestClass',           {the registered class name}
                             'API Window',          {the title bar text}
                             WS_VISIBLE OR          {the MDI child window is visible,}
                             WS_CAPTION OR          {has a caption bar,}
                             WS_SYSMENU OR          {a system menu,}
                             WS_MINIMIZEBOX OR      {and minimize and}
                             WS_MAXIMIZEBOX,        {maximize boxes}
                             CW_USEDEFAULT,         {default horizontal position}
                             CW_USEDEFAULT,         {default vertical position}
                             CW_USEDEFAULT,         {default width}
                             CW_USEDEFAULT,         {default height}
                             Form1.ClientHandle,    {handle of the MDI client window}
                             hInstance,             {the application instance}
                             0                      {no additional information}
                             );

  {if our window was created successfully, show it}
  if hWindow <> 0 then
  begin
    ShowWindow(hWindow, SW_SHOWNORMAL);
    UpdateWindow(hWindow);
  end
  else
  begin
    ShowMessage('CreateWindow failed');
    Exit;
  end;

end;
end.

Create New Windows

unit CreateAWindowu;

interface

uses
  Windows, Messages, SysUtils, 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}

{ Register the Window Class }
function RegisterClass: Boolean;
var
  WindowClass: TWndClass;
begin
  {setup our new window class}
  WindowClass.Style := CS_HREDRAW or CS_VREDRAW;           {set the class styles}
  WindowClass.lpfnWndProc := @DefWindowProc;               {point to the default window procedure}
  WindowClass.cbClsExtra := 0;                             {no extra class memory}
  WindowClass.cbWndExtra := 0;                             {no extra window memory}
  WindowClass.hInstance := hInstance;                      {the application instance}
  WindowClass.hIcon := 0;                                  {no icon specified}
  WindowClass.hCursor := 0;                                {no cursor specified}
  WindowClass.hbrBackground := COLOR_WINDOW;               {use a predefined color}
  WindowClass.lpszMenuName := nil;                         {no menu}
  WindowClass.lpszClassName := 'TestClass';                {the registered class name}

  {now that we have our class set up, register it with the system}
  Result := Windows.RegisterClass(WindowClass) <> 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hWindow: HWND;
begin
  {Step 1: Register our new window class}
  if not RegisterClass then
  begin
    ShowMessage('RegisterClass failed');
    Exit;
  end;

  {Step 2: Create a window based on our new class}
  hWindow := CreateWindow('TestClass',           {the registered class name}
                          'New Window',          {the title bar text}
                          WS_OVERLAPPEDWINDOW,   {a normal window style}
                          CW_USEDEFAULT,         {default horizontal position}
                          CW_USEDEFAULT,         {default vertical position}
                          CW_USEDEFAULT,         {default width}
                          CW_USEDEFAULT,         {default height}
                          0,                     {no owner window}
                          0,                     {no menu}
                          hInstance,             {the application instance}
                          nil                    {no additional information}
                          );

  {Step 3: If our window was created successfully, display it}
  if hWindow <> 0 then
  begin
    ShowWindow(hWindow, SW_SHOWNORMAL);
    UpdateWindow(hWindow);
  end
  else
  begin
    ShowMessage('CreateWindow failed');
    Exit;
  end;

end;

end.

Explore Folder

function ExploreFolder(const Folder: string): Boolean;

begin

if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then

// Folder is valid directory: try to explore it

Result := ShellAPI.ShellExecute(

0, 'explore', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL

) > 32

else

// Folder is not a directory: error

Result := False;

end;

Open Folder

function OpenFolder(const Folder: string): Boolean;

begin

if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then

// Folder is valid directory: try to open it

Result := ShellAPI.ShellExecute(

0, 'open', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL

) > 32

else

// Folder is not a directory: error

Result := False;

end;

Draw Polygon in Form

Type

PtsType = array [0..15, 0..1] of Integer;

const

Pts: PtsType = ((0, 0), (800, 0), (800, 600),

(200, 600), (200, 220), (300, 280),

(265, 205), (350, 117), (205, 170),

(120, 90), (130, 200), (60, 350), (200, 220),

(200, 600), (0, 600), (0, 0));

procedure TForm1.Button1Click(Sender: TObject);

var

HRegion1: THandle;

begin

HRegion1 := CreatePolygonRgn(Pts, SizeOf(Pts) div 8, alternate);

SetWindowRgn(Handle, HRegion1, True);

end;