Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Компонент на основе TImageList позволяет использовать в приложении анимированные иконки
unit
AnimIcon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ShellApi, TypInfo;
const
WM_FROMTRAYICON = WM_USER + 59;
type
TIconPlace = (ipAppIcon, ipAppMainFormIcon, ipFormIcon, ipImageCtrl,
ipSysTray);
TOnTimerEventOrder = (First, Second);
TIconPlaceSet = set
of
TIconPlace; TTimerEvent = procedure
(Sender: TObject) of
object
; TAnimIcon = class
(TImageList)
private
{ Private declarations }
FIconPlaceSet: TIconPlaceSet;
FEnabled: Boolean;
FInterval: Cardinal;
FNumIco: Integer;
FOnTimer: TTimerEvent;
FImage: TImage;
FAuthor: string
; FTip: string
; FActionForIconOnSysTray: Byte; FOnTimerEventOrder: TOnTimerEventOrder; FhWnd: hWnd; procedure
PlaceIcon; protected
{ Protected declarations }
procedure
Loaded; override
; procedure
SetEnabled(Value: Boolean); function
GetEnabled: Boolean; procedure
SetInterval(Value: Cardinal); function
GetInterval: Cardinal; procedure
OnAnimIconTimer(Sender: TObject); procedure
SetImage(Value: TImage); function
GetImage: TImage; procedure
SetAuthor(Value: string
); public
{ Public declarations }
published
{ Published declarations }
constructor
Create(AOwner: Tcomponent); override
; //Конструктор destructor
Destroy; override
; property
IconPlace: TIconPlaceSet read
FIconPlaceSet write
FIconPlaceSet; property
Enabled: Boolean read
GetEnabled write
SetEnabled;
property
Interval: Cardinal read
GetInterval write
SetInterval;
property
OnTimer: TTimerEvent read
FOnTimer write
FOnTimer;
property
ImageCtrl: TImage read
GetImage write
SetImage;
property
Author: string
read
FAuthor write
SetAuthor;
property
SysTrayTip: string
read
FTip write
FTip;
property
OnTimerEventOrder: TOnTimerEventOrder read
FOnTimerEventOrder write
FOnTimerEventOrder; end
;
var
Timer: TTimer;
procedure
Register
; function
SysTrayIcon(hWindow: THandle; ID: Cardinal; ICON: hicon; CallbackMessage: Cardinal; Tip: string
; Action: Byte): Boolean;
implementation
procedure
Register
; begin
RegisterComponents('MyComponents', [TAnimIcon]);
end
;
function
SysTrayIcon(hWindow: THandle; ID: Cardinal; Icon: hicon; CallbackMessage: Cardinal; Tip: string
; Action: Byte): Boolean; var
NID: TNotifyIconData;
begin
FillChar(NID, SizeOf(TNotifyIconData), 0);
with
NID do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := hWindow;
uID := ID;
uFlags := NIF_MESSAGE or
NIF_ICON or
NIF_TIP; uCallbackMessage := CallbackMessage; hIcon := Icon; if
Length(Tip) > 63 then
SetLength(Tip, 63); StrPCopy(szTip, Tip); end
;
case
Action of
1: Result := Shell_NotifyIcon(NIM_ADD, @NID); 2: Result := Shell_NotifyIcon(NIM_MODIFY, @NID); 3: Result := Shell_NotifyIcon(NIM_DELETE, @NID); else
Result := False;
end
;
end
;
procedure
TAnimIcon.PlaceIcon; var
Icon: TIcon;
CallbackMessage: Cardinal;
begin
Inc(FNumIco);
if
FNumIco > Count then
FNumIco := 1; if
ipAppIcon in
FIconPlaceSet then
begin
GetIcon(FNumIco - 1, Application.Icon);
Application.ProcessMessages;
end
;
if
ipFormIcon in
FIconPlaceSet then
begin
GetIcon(FNumIco - 1, TForm(Owner).Icon);
Application.ProcessMessages;
end
;
if
ipAppMainFormIcon in
FIconPlaceSet then
begin
if
Assigned(Application.MainForm) then
GetIcon(FNumIco - 1, Application.MainForm.Icon); Application.ProcessMessages; end
;
if
ipImageCtrl in
FIconPlaceSet then
begin
if
FImage <> nil
then
GetIcon(FNumIco - 1, FImage.Picture.Icon); Application.ProcessMessages; end
;
if
ipSysTray in
FIconPlaceSet then
begin
Icon := TIcon.Create;
GetIcon(FNumIco - 1, Icon);
CallbackMessage := WM_FROMTRAYICON;
SysTrayIcon(FhWnd, 0, Icon.Handle, CallbackMessage, FTip,
FActionForIconOnSysTray);
Application.ProcessMessages;
if
FActionForIconOnSysTray = 1 then
FActionForIconOnSysTray := 2; end
;
end
;
constructor
TAnimIcon.Create(AOwner: TComponent); begin
inherited
create(AOwner);
FAuthor := 'V-Isa aka Inter';
FNumIco := 0;
Timer := TTimer.Create(Self);
Application.ProcessMessages;
SetEnabled(False);
SetInterval(1000);
Timer.OnTimer := OnAnimIconTimer;
FActionForIconOnSysTray := 0;
FOnTimerEventOrder := First;
if
csDesigning in
ComponentState then
FTip := (Owner as
TForm).Caption; end
;
destructor
TAnimIcon.Destroy; var
Icon: TIcon;
CallbackMessage: Cardinal;
begin
if
ipSysTray in
FIconPlaceSet then
begin
Icon := TIcon.Create;
CallbackMessage := WM_FROMTRAYICON;
SysTrayIcon(FhWnd, 0, Icon.Handle, CallbackMessage, FTip, 3);
Application.ProcessMessages;
end
;
FNumIco := 0;
FEnabled := False;
Timer.Enabled := FEnabled;
Application.ProcessMessages;
inherited
destroy; end
;
procedure
TAnimIcon.OnAnimIconTimer(Sender: TObject); begin
if
Assigned(FOnTimer) and
(FOnTimerEventOrder = First) then
FOnTimer(Self);
Application.ProcessMessages;
if
Count > 0 then
begin
PlaceIcon;
end
;
Application.ProcessMessages;
if
Assigned(FOnTimer) and
(FOnTimerEventOrder = Second) then
FOnTimer(Self);
Application.ProcessMessages;
end
;
procedure
TAnimIcon.SetEnabled(Value: Boolean); begin
if
(Value = True) and
(csDesigning in
ComponentState) then
begin
Value := False;
FNumIco := 0;
FEnabled := Value;
Timer.Enabled := FEnabled;
Application.ProcessMessages;
ShowMessage('Изменение данного свойства возможно только' +
#13'во время выполнения программы!!!');
Exit;
end
;
if
(Value = True) and
(Count > 0) then
begin
FActionForIconOnSysTray := 1;
PlaceIcon;
end
;
if
Value = False then
begin
FActionForIconOnSysTray := 3;
PlaceIcon;
end
;
Application.ProcessMessages;
if
Value = False then
FNumIco := 0; FEnabled := Value; Timer.Enabled := FEnabled; Application.ProcessMessages; end
;
function
TAnimIcon.GetEnabled: Boolean; begin
GetEnabled := FEnabled;
end
;
procedure
TAnimIcon.SetInterval(Value: Cardinal); begin
FInterval := Value;
Timer.Interval := FInterval;
Application.ProcessMessages;
end
;
function
TAnimIcon.GetInterval: Cardinal; begin
GetInterval := FInterval;
end
;
procedure
TAnimIcon.SetImage(Value: TImage); begin
FImage := Value;
end
;
function
TAnimIcon.GetImage: TImage; begin
GetImage := FImage;
end
;
procedure
TAnimIcon.SetAuthor(Value: string
); begin
FAuthor := 'V-Isa aka Inter';
end
;
procedure
TAnimIcon.Loaded; begin
inherited
Loaded; FhWnd := (Owner as
TForm).Handle; end
;
end
.