abfcomponentsdemomain.pas

一个非常好的OUTLOOK EXPRESS接口控件

  UpdateIconProp;
  chbWPHActive.Checked := abfWndProcHook.Active;
  chbWPHAutoDrag.Checked := abfWndProcHook.AutoDrag;
  UpdateWav;
// Fix form width and height
  Width  := cWidth;
  Height := cHeight;
{$IfDef D4}
  OnCanResize := FormCanResize;
{$EndIf D4}
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.FormResize(Sender: TObject);
begin
{$IfNDef D4}
  if Width  < cWidth  then Width  := cWidth;
  if Height < cHeight then Height := cHeight;
{$EndIf D4}
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  if NewWidth  < cWidth  then NewWidth  := cWidth;
  if NewHeight < cHeight then NewHeight := cHeight;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.ComponentIconClick(Sender: TObject);
begin
  case (Sender as TComponent).Tag of
    1: abfComponentAboutEx(abfAppProp, '', '', True);
    2: abfComponentAboutEx(abfAutoRun, '', '', True);
    3: abfComponentAboutEx(abfOneInstance, '', '', True);
    4: abfComponentAboutEx(abfTrayIcon, '', '', True);
    5: abfComponentAboutEx(abfWndProcHook, '', '', True);
    6: abfComponentAboutEx(abfWav, '', '', True);
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.AboutClick(Sender: TObject);
begin
  abfApplicationAboutEx(Application.Title, ''{SabfVCLVersion}, '', '',
    True, nil);
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.CloseClick(Sender: TObject);
begin
  Close;
end;


//==============================================================================
// TbfApplicationProperties

procedure TfrmComponentsDemoMain.chbAppPropBeepClick(Sender: TObject);
var
  Event: TNotifyEvent;
begin
  with (Sender as TCheckBox) do
  begin
    if Checked then Event := DoBeep else Event := nil;
    case Tag of
      1: abfAppProp.OnMinimize := Event;
      2: abfAppProp.OnRestore := Event;
      3: abfAppProp.OnActivate := Event;
      4: abfAppProp.OnDeactivate := Event;
      5: abfAppProp.OnHint := Event;
    end;
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.btnAppPropHintColorClick(Sender: TObject);
begin
  dlgColor.Color := abfAppProp.HintColor;
  if not dlgColor.Execute then Exit;
  abfAppProp.HintColor := dlgColor.Color;
  ChangeAppPropGlyph;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.edAppPropHintChange(Sender: TObject);
var
  UD: TUpDown;
  Value: Integer;
begin
  if (csLoading in ComponentState) then Exit;
  with (Sender as TEdit) do
  begin
    UD := TUpDown(Self.FindComponent('ud' + Copy(Name, 3, MaxInt)));
    Value := StrToIntDef(Text, UD.Position);
    Text := IntToStr(Value);
    case Tag of
      1: abfAppProp.HintPause := Value;
      2: abfAppProp.HintHidePause := Value;
      3: abfAppProp.HintShortPause := Value;
    end;
  end;
end;


//==============================================================================
// TabfAutoRun

procedure TfrmComponentsDemoMain.chbAutoRunClick(Sender: TObject);
begin
  abfAutoRun.AutoRun := (Sender as TCheckBox).Checked;
end;


//==============================================================================
// TabfOneInstance

procedure TfrmComponentsDemoMain.btnOneInstanceClick(Sender: TObject);
var
  CmdLine: string;
begin
  CmdLine := Application.ExeName;
  WinExec(PChar(CmdLine), 0);
end;


//==============================================================================
// TabfTrayIcon

procedure TfrmComponentsDemoMain.edIconHintChange(Sender: TObject);
begin
  abfTrayIcon.Hint := TEdit(Sender).Text;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.btnIconLoadClick(Sender: TObject);
begin
  if not dlgIconLoad.Execute then Exit;
  abfTrayIcon.CycleIcons := False; //Stop the icons cycling
  abfTrayIcon.Icon.LoadFromFile(dlgIconLoad.FileName);
  UpdateIconProp;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbIconEnabledClick(Sender: TObject);
begin
  abfTrayIcon.Enabled := TCheckBox(Sender).Checked;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbIconCycleIconsClick(Sender: TObject);
begin
  abfTrayIcon.CycleIcons := TCheckBox(Sender).Checked;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbIconMinimizeToTrayClick(Sender: TObject);
begin
  abfTrayIcon.MinimizeToTray := TCheckBox(Sender).Checked;
// Prevent minimize to tray when the icon is disabled
  if abfTrayIcon.MinimizeToTray then
  begin
    abfTrayIcon.Enabled := True;
    UpdateIconProp;
    chbIconEnabled.Enabled := False;
  end else
    chbIconEnabled.Enabled := True;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbIconPopupByLeftClick(Sender: TObject);
begin
  abfTrayIcon.PopupByLeft := TCheckBox(Sender).Checked;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.btnIconShowClick(Sender: TObject);
begin
  abfTrayIcon.Show;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.btnIconHideClick(Sender: TObject);
begin
  abfTrayIcon.Hide;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.btnIconBaloonClick(Sender: TObject);
begin
  abfTrayIcon.ShowInfo;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.miIconHideAppClick(Sender: TObject);
begin
  abfTrayIcon.HideMainForm;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.miIconShowAppClick(Sender: TObject);
begin
  abfTrayIcon.ShowMainForm;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.abfTrayIconBalloonClick(Sender: TObject);
begin
  ShowMessage('You clicked on the Balloon Info');
end;

       
//==============================================================================
// TabfWndProcHook

procedure TfrmComponentsDemoMain.abfWndProcHookMessageBefore(Sender: TObject;
  var Msg: TMessage; var Handled: Boolean);
begin
  Handled := False;
  case Msg.Msg of
    WM_LButtonDown, WM_MButtonDown, WM_RButtonDown:
      if chbWPHMouseDown.Checked then Beep;
{    WM_LButtonUp, WM_MButtonUp, WM_RButtonUp:
      if chbWPHMouseUp.Checked then Beep;}
    WM_KeyDown: if chbWPHKeyDown.Checked then Beep;
    WM_KeyUp: if chbWPHKeyUp.Checked then Beep;
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbWPHActiveClick(Sender: TObject);
begin
  abfWndProcHook.Active := (Sender as TCheckBox).Checked;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbWPHAutoDragClick(Sender: TObject);
begin
  abfWndProcHook.AutoDrag := (Sender as TCheckBox).Checked;
end;


//==============================================================================
// TabfWave

procedure TfrmComponentsDemoMain.abfWavPlayAfter(Sender: TObject);
begin
  if abfWav.Looped then Exit;
  FSoundPlayed := False;
  UpdateWavButton;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.abfWavPlayBefore(Sender: TObject);
begin
  FSoundPlayed := True;
  UpdateWavButton;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.btnWavClick(Sender: TObject);
begin
  if FSoundPlayed then StopSound else abfWav.Play;
  UpdateWavButton;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbWavAsyncClick(Sender: TObject);
begin
  StopSound;
  abfWav.AsyncPlay := (Sender as TCheckBox).Checked;
// Prevent freeze a synchronous playing of looped sound
  if not abfWav.AsyncPlay then
  begin
    abfWav.Looped := False;
    UpdateWav;
    chbWavLopped.Enabled := False;
  end else
    chbWavLopped.Enabled := True;
  UpdateWavButton;
end;

//------------------------------------------------------------------------------

procedure TfrmComponentsDemoMain.chbWavLoppedClick(Sender: TObject);
begin
  StopSound;
  abfWav.Looped := (Sender as TCheckBox).Checked;
  UpdateWavButton;
end;

//------------------------------------------------------------------------------


end{unit abfComponentsDemoMain}.