?? abfcomponentsdemomain.pas
字號:
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}.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -