main.pas

Delphi 有很多很好的例子

unit Main;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Grids, Calendar;

type
  TMainForm = class(TForm)
    ToolbarPanel: TPanel;
    RingSB: TSpeedButton;
    DateSB: TSpeedButton;
    TimeSB: TSpeedButton;
    CalendarSB: TSpeedButton;
    ExitSB: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Bevel1: TBevel;
    Calendar1: TCalendar;
    procedure SBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SBMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RingSBClick(Sender: TObject);
    procedure DateSBClick(Sender: TObject);
    procedure TimeSBClick(Sender: TObject);
    procedure CalendarSBClick(Sender: TObject);
    procedure ExitSBClick(Sender: TObject);
  private
    { Private declarations }
    function InToolbar(Sender: TObject): Boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  isNotInToolbar = 0;
  isInToolbar    = 1;    //定义常量，如果返回值为真，则代表按钮位于工具栏中


function TMainForm.InToolbar(Sender: TObject): Boolean;
begin
  with Sender as TSpeedButton do
  if Tag = isNotInToolbar then
  begin
    Tag := isInToolbar;   //设置Tag标识
    Result := False;      //返回函数值为False
  end else
    Result := True;        //返回函数值为True
end;

procedure TMainForm.SBMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Sender as TSpeedButton do
  if Tag = isNotInToolbar then
  begin { Assign OnClick event handler to a button }
    if Sender = RingSB then
      RingSB.OnClick := RingSBClick
    else if Sender = DateSB then
      DateSB.OnClick := DateSBClick
    else if Sender = TimeSB then
      TimeSB.OnClick := TimeSBClick
    else if Sender = CalendarSB then
      CalendarSB.OnClick := CalendarSBClick
    else if Sender = ExitSB then
      ExitSB.OnClick := ExitSBClick;
  end;
end;


procedure TMainForm.SBMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Sender as TSpeedButton do
  if Tag = isNotInToolbar then
  begin       //将快捷按钮移至工具栏中
    Parent := ToolbarPanel;
    Top := 0;
  end;
end;


procedure TMainForm.RingSBClick(Sender: TObject);
begin
  if InToolbar(Sender) then       //响应单击铃声按钮
    MessageBeep(0);
end;


procedure TMainForm.DateSBClick(Sender: TObject);
begin
  if InToolbar(Sender) then
    ShowMessage('当前日期是' + DateToStr(Date));  //响应单击日期按钮
end;


procedure TMainForm.TimeSBClick(Sender: TObject);
begin
  if InToolbar(Sender) then
    ShowMessage('当前时间是 ' + TimeToStr(Time));  //响应单击时间按钮
end;


procedure TMainForm.CalendarSBClick(Sender: TObject);
begin
  if InToolbar(Sender) then
  with Calendar1 do
  begin
    Align := alClient;
    Visible := not Visible;   //响应单击日历按钮
  end;
end;


procedure TMainForm.ExitSBClick(Sender: TObject);
begin
  if InToolbar(Sender) then    //响应单击退出按钮
    Close;
end;

end.