Перейти к содержанию
Fire Monkey от А до Я

dnekrasov

Пользователи
  • Постов

    317
  • Зарегистрирован

  • Посещение

  • Победитель дней

    52

Активность репутации

  1. Like
    dnekrasov отреагировална Brovin Yaroslav в Таймер в сервисе   
    Посмотрите на реализацию системных таймеров в Androidapi.Timer.pas. Они подходят для сервисов.
  2. Like
    dnekrasov отреагировална kami в Динамическое создание/уничтожение   
    Нужно использовать myObject.Release, а не Free.
    Только обратите внимание, что Release - это отложенное уничтожение, т.е. моментально компонент исчезает с формы, а вот уничтожится - после, когда-нибудь, когда до него дойдет очередь.
    Помимо этого, если ссылка на объект есть где-то в поле класса, то нужно заnil-ить ее, дабы уменьшить счетчик ссылок.
  3. Like
    dnekrasov получил реакцию от Илья Ненашев в GlowEffect на кнопке   
    Зачем? Ведь стиль для того и создается, чтобы не заморачиваться над UI. 
    В редакторе стилей у GlowEffect поставить Enabled=False и в триггере выбрать IsPressed=True - и наслаждайтесь
  4. Like
    dnekrasov отреагировална tromani в Ошибка "Bitmap size too big"   
    в общем итоговая процедура получилась у меня вот так, при этом заработало там где до этого не работало
    procedure CheckAndLoadFromStream(FileName:string; const ABitmap : TBitmap); var MaxImageSize : Integer; ABitmapSurface,ABitmapSurfaceResize : TBitmapSurface; mxH,mxW:integer; begin ABitmapSurface:=TBitmapSurface.Create; ABitmapSurfaceResize:=TBitmapSurface.Create; TBitmapCodecManager.LoadFromFile(FileName,ABitmapSurface); MaxImageSize:=TCanvasManager.DefaultCanvas.GetAttribute(TCanvasAttribute.MaxBitmapSize); if (ABitmapSurface.Height>MaxImageSize) or (ABitmapSurface.Width>MaxImageSize) then begin if ABitmapSurface.Height>ABitmapSurface.Width then begin mxH:=MaxImageSize; mxW:=Round(mxH/ABitmapSurface.Height*ABitmapSurface.Height); end else begin mxW:=MaxImageSize; mxH:=Round(mxW/ABitmapSurface.Width*ABitmapSurface.Height); end; end else begin mxW:=ABitmapSurface.Width; mxH:=ABitmapSurface.Height; end; ABitmapSurfaceResize.SetSize(mxW,mxH); ABitmapSurfaceResize.StretchFrom(ABitmapSurface,mxW,mxH); FreeAndNil(ABitmapSurface); ABitmap.SetSize(mxW,mxH); ABitmap.Assign(ABitmapSurfaceResize); FreeAndNil(ABitmapSurfaceResize); end;
  5. Like
    dnekrasov отреагировална tromani в Ошибка "Bitmap size too big"   
    попробуй переставь
    ABitmapSurfaceResize:=TBitmapSurface.Create; после 
    ABitmapSurface:=TBitmapSurface.Create; и
    после определения максимальных длины и ширины  - сделай ABitmapSurfaceResize.SetSize
    у меня по крайней мере заработало.
     
  6. Like
    dnekrasov получил реакцию от rakhmet в Ассоциация файлов с программой на MacOS   
    Тоже интересовал этот вопрос. Нарыл кучу информации, но в конце концов реализовал этот механизм.
    Смотрите прикрепленный архивчик - там простенький проект, показывающий как ото сделать. Проверял на Delphi 10 Seattle + OS X El Capitan 10.11.4
    OpenWith.zip
  7. Like
    dnekrasov получил реакцию от Rusland в Ошибка "Bitmap size too big"   
    Опытным путем выяснил что это не так. Это максимальная сторона изображения, а пропорции его не должны превышать пропорции монитора (может десктопа?).
    Т.е. если TCanvasManager.DefaultCanvas.GetAttribute(TCanvasAttribute.MaxBitmapSize) возвращает 8192, то для монитора с разрешением 1440х900 можно создать битмапку размером не больше чем 8192х5120,  в противном случае получаю ошибки "Cannot create texture for 'TCanvasD2D'" или "Stack overflow"
     
    Позже попробую поэкспериментировать на десктопе, растянутом на 2 монитора с портретной и ландшафтной ориентацией.
  8. Like
    dnekrasov получил реакцию от rareMax в Ошибка "Bitmap size too big"   
    Опытным путем выяснил что это не так. Это максимальная сторона изображения, а пропорции его не должны превышать пропорции монитора (может десктопа?).
    Т.е. если TCanvasManager.DefaultCanvas.GetAttribute(TCanvasAttribute.MaxBitmapSize) возвращает 8192, то для монитора с разрешением 1440х900 можно создать битмапку размером не больше чем 8192х5120,  в противном случае получаю ошибки "Cannot create texture for 'TCanvasD2D'" или "Stack overflow"
     
    Позже попробую поэкспериментировать на десктопе, растянутом на 2 монитора с портретной и ландшафтной ориентацией.
  9. Like
    dnekrasov получил реакцию от Rusland в Align кнопок   
    Перед тем как сделать кнопку видимой присвоить ей Position.X на 1 больше чем Position.X кнопки, за которой она должна следовать
  10. Like
    dnekrasov получил реакцию от RapsodRF в [Win][FMX] Не работает RegisterHotKey   
    Нужно переопределять основной обработчик событий окна, но легче всего сделать так:
    ... FWnd := AllocateHWnd(WindowProc); ... procedure WindowProc(var AMsg: TMessage); begin case AMsg.Msg of WM_HOTKEY: case TWMHotKey(AMsg).hotkey of 1: ...; 2: ...; ... end; end; end; ... RegisterHotkey(FWnd, ...); // как обычно в VCL ... UnregisterHotkey(...); // как обычно в VCL ...  
    С OSX не все так просто.
    Посмотрите темы
    Глобальный Hook в OSX и Глобальные хоткеи в OS X
  11. Like
    dnekrasov получил реакцию от Tarik Live в Таймер в сервисе   
    В архиве - простенький проект. Протестирован на Win и OSX.
     
    TimerThreadDemo.zip
  12. Like
    dnekrasov получил реакцию от Tarik Live в Таймер в сервисе   
    Когда-то, лет 5 назад у меня возникла такая-же проблема, только в Win32-сервисе. Тогда, для её решения, я написал 2 простеньких класса.
    Вот код, может пригодится?
    unit Utils.TimerThread; interface uses System.Classes, System.SysUtils, System.SyncObjs; type TCustomTimerThread = class abstract (TThread) private FLock: TCriticalSection; FCancelledEvent: TSimpleEvent; FInterval: Integer; FOnTimer: TNotifyEvent; function GetInterval: Integer; function GetOnTimer: TNotifyEvent; procedure SetInterval(const Value: Integer); procedure SetOnTimer(const Value: TNotifyEvent); protected procedure Lock; procedure Unlock; procedure Sleep(AInterval: Integer); reintroduce; procedure TerminatedSet; override; procedure DoOnTimer; virtual; public constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent); reintroduce; procedure BeforeDestruction; override; procedure Cancel; virtual; property Interval: Integer read GetInterval write SetInterval; /// <summary> /// <para> /// За синхронизацией потоков отвечает поток в котором обрабатывается OnTimer /// </para> /// <para> /// !!! НЕ ЗАБЫВАТЬ ПРО ЭТО !!! /// </para> /// </summary> property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer; end; /// <summary> /// Simple wait thread /// </summary> /// <remarks> /// <para> /// !!! Important !!! /// </para> /// <para> /// Use Cancel instead of Terminate. You can get ThreadExternalTerminate /// exception in multi-thread applications /// </para> /// </remarks> TWaitThread = class(TCustomTimerThread) protected procedure Execute; override; public end; /// <summary> /// Thread independed timer /// </summary> /// <remarks> /// <para> /// !!! Important !!! /// </para> /// <para> /// Use Cancel instead of Terminate. You can get ThreadExternalTerminate /// exception in multi-thread applications /// </para> /// </remarks> TTimerThread = class(TCustomTimerThread) private FEnabled: Boolean; function GetEnabled: Boolean; procedure SetEnabled(const Value: Boolean); protected procedure Execute; override; public constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean = True); reintroduce; property Enabled: Boolean read GetEnabled write SetEnabled; end; implementation { TCustomTimerThread } procedure TCustomTimerThread.BeforeDestruction; begin FLock.Free; FreeAndNil(FCancelledEvent); inherited; end; constructor TCustomTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent); begin inherited Create; FInterval := AInterval; FOnTimer := AOnTimer; FreeOnTerminate := True; FLock := TCriticalSection.Create; FCancelledEvent := TSimpleEvent.Create; FCancelledEvent.ResetEvent; end; procedure TCustomTimerThread.Cancel; begin FCancelledEvent.SetEvent; end; procedure TCustomTimerThread.DoOnTimer; begin if Assigned(OnTimer) then OnTimer(Self); end; function TCustomTimerThread.GetInterval: Integer; begin Lock; try Result := FInterval; finally Unlock; end; end; function TCustomTimerThread.GetOnTimer: TNotifyEvent; begin Lock; try Result := FOnTimer; finally Unlock; end; end; procedure TCustomTimerThread.Lock; begin FLock.Enter; end; procedure TCustomTimerThread.SetInterval(const Value: Integer); begin Lock; try FInterval := Value; finally Unlock; end; end; procedure TCustomTimerThread.SetOnTimer(const Value: TNotifyEvent); begin Lock; try FOnTimer := Value; finally Unlock; end; end; procedure TCustomTimerThread.Sleep(AInterval: Integer); begin FCancelledEvent.WaitFor(AInterval); end; procedure TCustomTimerThread.TerminatedSet; begin inherited; FCancelledEvent.SetEvent; end; procedure TCustomTimerThread.Unlock; begin FLock.Leave; end; { TWaitThread } procedure TWaitThread.Execute; begin if FCancelledEvent.WaitFor(FInterval) = wrTimeout then DoOnTimer; end; { TTimerThread } constructor TTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean); begin inherited Create(AInterval, AOnTimer); FOnTimer := AOnTimer; FEnabled := AEnabled; end; procedure TTimerThread.Execute; begin while not Terminated do case FCancelledEvent.WaitFor(FInterval) of wrTimeout: begin if Enabled then DoOnTimer; end; else Break; end; end; function TTimerThread.GetEnabled: Boolean; begin Lock; try Result := FEnabled; finally Unlock; end; end; procedure TTimerThread.SetEnabled(const Value: Boolean); begin Lock; try FEnabled := Value; finally Unlock; end; end; end.  
  13. Thanks
    dnekrasov получил реакцию от Mars M в Таймер в сервисе   
    В архиве - простенький проект. Протестирован на Win и OSX.
     
    TimerThreadDemo.zip
  14. Like
    dnekrasov получил реакцию от Pax Beach в Таймер в сервисе   
    Не забудьте поделиться
  15. Like
    dnekrasov получил реакцию от Brovin Yaroslav в Таймер в сервисе   
    В архиве - простенький проект. Протестирован на Win и OSX.
     
    TimerThreadDemo.zip
  16. Like
    dnekrasov получил реакцию от Brovin Yaroslav в Таймер в сервисе   
    Когда-то, лет 5 назад у меня возникла такая-же проблема, только в Win32-сервисе. Тогда, для её решения, я написал 2 простеньких класса.
    Вот код, может пригодится?
    unit Utils.TimerThread; interface uses System.Classes, System.SysUtils, System.SyncObjs; type TCustomTimerThread = class abstract (TThread) private FLock: TCriticalSection; FCancelledEvent: TSimpleEvent; FInterval: Integer; FOnTimer: TNotifyEvent; function GetInterval: Integer; function GetOnTimer: TNotifyEvent; procedure SetInterval(const Value: Integer); procedure SetOnTimer(const Value: TNotifyEvent); protected procedure Lock; procedure Unlock; procedure Sleep(AInterval: Integer); reintroduce; procedure TerminatedSet; override; procedure DoOnTimer; virtual; public constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent); reintroduce; procedure BeforeDestruction; override; procedure Cancel; virtual; property Interval: Integer read GetInterval write SetInterval; /// <summary> /// <para> /// За синхронизацией потоков отвечает поток в котором обрабатывается OnTimer /// </para> /// <para> /// !!! НЕ ЗАБЫВАТЬ ПРО ЭТО !!! /// </para> /// </summary> property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer; end; /// <summary> /// Simple wait thread /// </summary> /// <remarks> /// <para> /// !!! Important !!! /// </para> /// <para> /// Use Cancel instead of Terminate. You can get ThreadExternalTerminate /// exception in multi-thread applications /// </para> /// </remarks> TWaitThread = class(TCustomTimerThread) protected procedure Execute; override; public end; /// <summary> /// Thread independed timer /// </summary> /// <remarks> /// <para> /// !!! Important !!! /// </para> /// <para> /// Use Cancel instead of Terminate. You can get ThreadExternalTerminate /// exception in multi-thread applications /// </para> /// </remarks> TTimerThread = class(TCustomTimerThread) private FEnabled: Boolean; function GetEnabled: Boolean; procedure SetEnabled(const Value: Boolean); protected procedure Execute; override; public constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean = True); reintroduce; property Enabled: Boolean read GetEnabled write SetEnabled; end; implementation { TCustomTimerThread } procedure TCustomTimerThread.BeforeDestruction; begin FLock.Free; FreeAndNil(FCancelledEvent); inherited; end; constructor TCustomTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent); begin inherited Create; FInterval := AInterval; FOnTimer := AOnTimer; FreeOnTerminate := True; FLock := TCriticalSection.Create; FCancelledEvent := TSimpleEvent.Create; FCancelledEvent.ResetEvent; end; procedure TCustomTimerThread.Cancel; begin FCancelledEvent.SetEvent; end; procedure TCustomTimerThread.DoOnTimer; begin if Assigned(OnTimer) then OnTimer(Self); end; function TCustomTimerThread.GetInterval: Integer; begin Lock; try Result := FInterval; finally Unlock; end; end; function TCustomTimerThread.GetOnTimer: TNotifyEvent; begin Lock; try Result := FOnTimer; finally Unlock; end; end; procedure TCustomTimerThread.Lock; begin FLock.Enter; end; procedure TCustomTimerThread.SetInterval(const Value: Integer); begin Lock; try FInterval := Value; finally Unlock; end; end; procedure TCustomTimerThread.SetOnTimer(const Value: TNotifyEvent); begin Lock; try FOnTimer := Value; finally Unlock; end; end; procedure TCustomTimerThread.Sleep(AInterval: Integer); begin FCancelledEvent.WaitFor(AInterval); end; procedure TCustomTimerThread.TerminatedSet; begin inherited; FCancelledEvent.SetEvent; end; procedure TCustomTimerThread.Unlock; begin FLock.Leave; end; { TWaitThread } procedure TWaitThread.Execute; begin if FCancelledEvent.WaitFor(FInterval) = wrTimeout then DoOnTimer; end; { TTimerThread } constructor TTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean); begin inherited Create(AInterval, AOnTimer); FOnTimer := AOnTimer; FEnabled := AEnabled; end; procedure TTimerThread.Execute; begin while not Terminated do case FCancelledEvent.WaitFor(FInterval) of wrTimeout: begin if Enabled then DoOnTimer; end; else Break; end; end; function TTimerThread.GetEnabled: Boolean; begin Lock; try Result := FEnabled; finally Unlock; end; end; procedure TTimerThread.SetEnabled(const Value: Boolean); begin Lock; try FEnabled := Value; finally Unlock; end; end; end.  
  17. Like
    dnekrasov получил реакцию от AngryOwl в Таймер в сервисе   
    Когда-то, лет 5 назад у меня возникла такая-же проблема, только в Win32-сервисе. Тогда, для её решения, я написал 2 простеньких класса.
    Вот код, может пригодится?
    unit Utils.TimerThread; interface uses System.Classes, System.SysUtils, System.SyncObjs; type TCustomTimerThread = class abstract (TThread) private FLock: TCriticalSection; FCancelledEvent: TSimpleEvent; FInterval: Integer; FOnTimer: TNotifyEvent; function GetInterval: Integer; function GetOnTimer: TNotifyEvent; procedure SetInterval(const Value: Integer); procedure SetOnTimer(const Value: TNotifyEvent); protected procedure Lock; procedure Unlock; procedure Sleep(AInterval: Integer); reintroduce; procedure TerminatedSet; override; procedure DoOnTimer; virtual; public constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent); reintroduce; procedure BeforeDestruction; override; procedure Cancel; virtual; property Interval: Integer read GetInterval write SetInterval; /// <summary> /// <para> /// За синхронизацией потоков отвечает поток в котором обрабатывается OnTimer /// </para> /// <para> /// !!! НЕ ЗАБЫВАТЬ ПРО ЭТО !!! /// </para> /// </summary> property OnTimer: TNotifyEvent read GetOnTimer write SetOnTimer; end; /// <summary> /// Simple wait thread /// </summary> /// <remarks> /// <para> /// !!! Important !!! /// </para> /// <para> /// Use Cancel instead of Terminate. You can get ThreadExternalTerminate /// exception in multi-thread applications /// </para> /// </remarks> TWaitThread = class(TCustomTimerThread) protected procedure Execute; override; public end; /// <summary> /// Thread independed timer /// </summary> /// <remarks> /// <para> /// !!! Important !!! /// </para> /// <para> /// Use Cancel instead of Terminate. You can get ThreadExternalTerminate /// exception in multi-thread applications /// </para> /// </remarks> TTimerThread = class(TCustomTimerThread) private FEnabled: Boolean; function GetEnabled: Boolean; procedure SetEnabled(const Value: Boolean); protected procedure Execute; override; public constructor Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean = True); reintroduce; property Enabled: Boolean read GetEnabled write SetEnabled; end; implementation { TCustomTimerThread } procedure TCustomTimerThread.BeforeDestruction; begin FLock.Free; FreeAndNil(FCancelledEvent); inherited; end; constructor TCustomTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent); begin inherited Create; FInterval := AInterval; FOnTimer := AOnTimer; FreeOnTerminate := True; FLock := TCriticalSection.Create; FCancelledEvent := TSimpleEvent.Create; FCancelledEvent.ResetEvent; end; procedure TCustomTimerThread.Cancel; begin FCancelledEvent.SetEvent; end; procedure TCustomTimerThread.DoOnTimer; begin if Assigned(OnTimer) then OnTimer(Self); end; function TCustomTimerThread.GetInterval: Integer; begin Lock; try Result := FInterval; finally Unlock; end; end; function TCustomTimerThread.GetOnTimer: TNotifyEvent; begin Lock; try Result := FOnTimer; finally Unlock; end; end; procedure TCustomTimerThread.Lock; begin FLock.Enter; end; procedure TCustomTimerThread.SetInterval(const Value: Integer); begin Lock; try FInterval := Value; finally Unlock; end; end; procedure TCustomTimerThread.SetOnTimer(const Value: TNotifyEvent); begin Lock; try FOnTimer := Value; finally Unlock; end; end; procedure TCustomTimerThread.Sleep(AInterval: Integer); begin FCancelledEvent.WaitFor(AInterval); end; procedure TCustomTimerThread.TerminatedSet; begin inherited; FCancelledEvent.SetEvent; end; procedure TCustomTimerThread.Unlock; begin FLock.Leave; end; { TWaitThread } procedure TWaitThread.Execute; begin if FCancelledEvent.WaitFor(FInterval) = wrTimeout then DoOnTimer; end; { TTimerThread } constructor TTimerThread.Create(AInterval: Integer; AOnTimer: TNotifyEvent; AEnabled: Boolean); begin inherited Create(AInterval, AOnTimer); FOnTimer := AOnTimer; FEnabled := AEnabled; end; procedure TTimerThread.Execute; begin while not Terminated do case FCancelledEvent.WaitFor(FInterval) of wrTimeout: begin if Enabled then DoOnTimer; end; else Break; end; end; function TTimerThread.GetEnabled: Boolean; begin Lock; try Result := FEnabled; finally Unlock; end; end; procedure TTimerThread.SetEnabled(const Value: Boolean); begin Lock; try FEnabled := Value; finally Unlock; end; end; end.  
  18. Like
    dnekrasov получил реакцию от Rusland в Ошибка "Bitmap size too big"   
    Попробуйте TBitmapSurface.StretchFrom
  19. Like
    dnekrasov получил реакцию от zairkz в RAD 11 на подходе?   
    На самом деле слишком уж громко они заявили о поддержке HDPI. На первый взгляд - сделали только масштабирование форм при включенной поддержке HDPI (ну может еще и реализацию MultyResBitmaps). А необходимое при работе с HDPI - осталось неизменным. Достаточно взглянуть на реализацию IFMXDeviceMetricsService.GetDisplayMetrics:
    function TPlatformWin.GetDisplayMetrics: TDeviceDisplayMetrics; var R: TRect; begin Winapi.Windows.GetWindowRect(GetDesktopWindow, R); Result.PhysicalScreenSize := TSize.Create(R.Width, R.Height); Result.RawScreenSize := Result.PhysicalScreenSize; Result.LogicalScreenSize := Result.PhysicalScreenSize; if Result.PhysicalScreenSize.cx > 0 then Result.AspectRatio := Result.PhysicalScreenSize.cy / Result.PhysicalScreenSize.cx else Result.AspectRatio := 1; Result.PixelsPerInch := 96; // Windows Default Result.ScreenScale := 1; Result.FontScale := 1; end; Как было так и осталось  
  20. Like
    dnekrasov отреагировална Brovin Yaroslav в Delphi Berlin iso установка проблема   
    Решение данной проблемы
    Открыть редактор реестр: regedit Заменить значение ключа реестра: HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Language\InstallLanguage с 0419 на 0409 Установить среду Восстановить значение ключа (2 пункт) с 0409 на 0419.  
  21. Like
    dnekrasov отреагировална RoschinSpb в C++Builder XE10 & ShowModal   
    По поводу позиции команды форума себя любимого могу сказать, что если мы по поводу каждого бага будем подрываться, то на основную работу не хватит времени вообще. У нас есть свои обязанности, а это рассматривайте это как хобби. Есть интересные вопросы, есть вопросы связанные с работой которую кто-то из нас делал, а здесь, простите, всё довольно банально да еще и на C.
    В общем я кину ссылку тестерам, пусть они создают багрепорт, но еще раз отмечу, что баг репорт от юзера имеет гораздо большее значение чем баг репорт от тестера и тем более от программиста.
  22. Like
    dnekrasov получил реакцию от enatechno в Ошибка "Bitmap size too big"   
    Попробуйте TBitmapSurface.StretchFrom
  23. Like
    dnekrasov получил реакцию от Rusland в Глобальные хоткеи в OS X   
    Хм... Сам задал вопрос и сам же на него отвечаю...
    Нашёл ещё один вариант:
    Импортировал несколько методов из Carbon.framework и всё получилось:
    uses Macapi.CocoaTypes, Macapi.ObjCRuntime, Macapi.CoreFoundation, Macapi.CoreServices; const HITFwk = '/System/Library/Frameworks/Carbon.framework/Frameworks/HIToolbox.framework/HIToolbox'; type EventParamName = OSType; EventParamNamePtr = ^EventParamName; EventParamType = OSType; EventParamTypePtr = ^EventParamType; EventRef = ^SInt32; EventRefPtr = ^EventRef; EventHotKeyIDPtr = ^EventHotKeyID; EventHotKeyID = record signature: OSType; id: UInt32; end; EventTypeSpec = record eventClass: OSType; eventKind: UInt32; end; EventTypeSpecPtr = ^EventTypeSpec; EventTargetRef = ^SInt32; EventHotKeyRef = ^SInt32; OptionBits = UInt32; ByteCountPtr = ^ByteCount; EventHandlerRef = ^SInt32; EventHandlerRefPtr = ^EventHandlerRef; EventHandlerCallRef = ^SInt32; EventHandlerCallRefPtr = ^EventHandlerCallRef; type EventHandlerProcPtr = function(inHandlerCallRef: EventHandlerCallRef; inEvent: EventRef; inUserData: Pointer): OSStatus; cdecl; EventHandlerUPP = EventHandlerProcPtr; const kEventHotKeyNoOptions = ; kEventHotKeyExclusive = 1 shl ; kEventRawKeyDown = 1; kEventRawKeyRepeat = 2; kEventRawKeyUp = 3; kEventRawKeyModifiersChanged = 4; kEventHotKeyPressed = 5; kEventHotKeyReleased = 6; kEventClassKeyboard: UInt32 = Ord('k') shl 24 + Ord('e') shl 16 + Ord('y') shl 8 + Ord('b'); typeEventHotKeyID: UInt32 = Ord('h') shl 24 + Ord('k') shl 16 + Ord('i') shl 8 + Ord('d'); typeWildCard: UInt32 = Ord('*') shl 24 + Ord('*') shl 16 + Ord('*') shl 8 + Ord('*'); kEventParamDirectObject: UInt32 = Ord('-') shl 24 + Ord('-') shl 16 + Ord('-') shl 8 + Ord('-'); const cmdKeyBit = 8; { command key down?} shiftKeyBit = 9; { shift key down?} optionKeyBit = 11; { option key down?} controlKeyBit = 12; { control key down?} cmdKey = 1 shl cmdKeyBit; shiftKey = 1 shl shiftKeyBit; optionKey = 1 shl optionKeyBit; controlKey = 1 shl controlKeyBit; // in version 10.0 and later in Carbon.framework function GetApplicationEventTarget: EventTargetRef; cdecl; external HITFwk name _PU + 'GetApplicationEventTarget'; {$EXTERNALSYM GetApplicationEventTarget} // in version 10.0 and later in Carbon.framework function InstallEventHandler(inTarget: EventTargetRef; inHandler: EventHandlerUPP; inNumTypes: UInt32; {const} inList: {variable-size-array} EventTypeSpecPtr; inUserData: Pointer; outRef: EventHandlerRefPtr { can be NULL } ): OSStatus; cdecl; external HITFwk name _PU + 'InstallEventHandler'; {$EXTERNALSYM InstallEventHandler} // in version 10.0 and later in Carbon.framework function RemoveEventHandler( inHandlerRef: EventHandlerRef ): OSStatus; cdecl; external HITFwk name _PU + 'RemoveEventHandler'; {$EXTERNALSYM RemoveEventHandler} // in version 10.0 and later in Carbon.framework function RegisterEventHotKey(inHotKeyCode: UInt32; inHotKeyModifiers: UInt32; inHotKeyID: EventHotKeyID; inTarget: EventTargetRef; inOptions: OptionBits; var outRef: EventHotKeyRef): OSStatus; cdecl; external HITFwk name _PU + 'RegisterEventHotKey'; {$EXTERNALSYM RegisterEventHotKey} // in version 10.0 and later in Carbon.framework function UnregisterEventHotKey(inHotKey: EventHotKeyRef): OSStatus; cdecl; external HITFwk name _PU + 'UnregisterEventHotKey'; {$EXTERNALSYM UnregisterEventHotKey} // in version 10.0 and later in Carbon.framework function GetEventParameter(inEvent: EventRef; inName: EventParamName; inDesiredType: EventParamType; outActualType: EventParamTypePtr { can be NULL }; inBufferSize: ByteCount; outActualSize: ByteCountPtr { can be NULL }; outData: Pointer { can be NULL } ): OSStatus; cdecl; external HITFwk name _PU + 'GetEventParameter'; {$EXTERNALSYM GetEventParameter}  
  24. Like
    dnekrasov получил реакцию от zairkz в Глобальные хоткеи в OS X   
    Ещё в AppKit.framework у NSEvent есть такой метод как addGlobalMonitorForEventsMatchingMask. Может кто использовал?
  25. Like
    dnekrasov получил реакцию от zairkz в Глобальные хоткеи в OS X   
    Хм... Сам задал вопрос и сам же на него отвечаю...
    Нашёл ещё один вариант:
    Импортировал несколько методов из Carbon.framework и всё получилось:
    uses Macapi.CocoaTypes, Macapi.ObjCRuntime, Macapi.CoreFoundation, Macapi.CoreServices; const HITFwk = '/System/Library/Frameworks/Carbon.framework/Frameworks/HIToolbox.framework/HIToolbox'; type EventParamName = OSType; EventParamNamePtr = ^EventParamName; EventParamType = OSType; EventParamTypePtr = ^EventParamType; EventRef = ^SInt32; EventRefPtr = ^EventRef; EventHotKeyIDPtr = ^EventHotKeyID; EventHotKeyID = record signature: OSType; id: UInt32; end; EventTypeSpec = record eventClass: OSType; eventKind: UInt32; end; EventTypeSpecPtr = ^EventTypeSpec; EventTargetRef = ^SInt32; EventHotKeyRef = ^SInt32; OptionBits = UInt32; ByteCountPtr = ^ByteCount; EventHandlerRef = ^SInt32; EventHandlerRefPtr = ^EventHandlerRef; EventHandlerCallRef = ^SInt32; EventHandlerCallRefPtr = ^EventHandlerCallRef; type EventHandlerProcPtr = function(inHandlerCallRef: EventHandlerCallRef; inEvent: EventRef; inUserData: Pointer): OSStatus; cdecl; EventHandlerUPP = EventHandlerProcPtr; const kEventHotKeyNoOptions = ; kEventHotKeyExclusive = 1 shl ; kEventRawKeyDown = 1; kEventRawKeyRepeat = 2; kEventRawKeyUp = 3; kEventRawKeyModifiersChanged = 4; kEventHotKeyPressed = 5; kEventHotKeyReleased = 6; kEventClassKeyboard: UInt32 = Ord('k') shl 24 + Ord('e') shl 16 + Ord('y') shl 8 + Ord('b'); typeEventHotKeyID: UInt32 = Ord('h') shl 24 + Ord('k') shl 16 + Ord('i') shl 8 + Ord('d'); typeWildCard: UInt32 = Ord('*') shl 24 + Ord('*') shl 16 + Ord('*') shl 8 + Ord('*'); kEventParamDirectObject: UInt32 = Ord('-') shl 24 + Ord('-') shl 16 + Ord('-') shl 8 + Ord('-'); const cmdKeyBit = 8; { command key down?} shiftKeyBit = 9; { shift key down?} optionKeyBit = 11; { option key down?} controlKeyBit = 12; { control key down?} cmdKey = 1 shl cmdKeyBit; shiftKey = 1 shl shiftKeyBit; optionKey = 1 shl optionKeyBit; controlKey = 1 shl controlKeyBit; // in version 10.0 and later in Carbon.framework function GetApplicationEventTarget: EventTargetRef; cdecl; external HITFwk name _PU + 'GetApplicationEventTarget'; {$EXTERNALSYM GetApplicationEventTarget} // in version 10.0 and later in Carbon.framework function InstallEventHandler(inTarget: EventTargetRef; inHandler: EventHandlerUPP; inNumTypes: UInt32; {const} inList: {variable-size-array} EventTypeSpecPtr; inUserData: Pointer; outRef: EventHandlerRefPtr { can be NULL } ): OSStatus; cdecl; external HITFwk name _PU + 'InstallEventHandler'; {$EXTERNALSYM InstallEventHandler} // in version 10.0 and later in Carbon.framework function RemoveEventHandler( inHandlerRef: EventHandlerRef ): OSStatus; cdecl; external HITFwk name _PU + 'RemoveEventHandler'; {$EXTERNALSYM RemoveEventHandler} // in version 10.0 and later in Carbon.framework function RegisterEventHotKey(inHotKeyCode: UInt32; inHotKeyModifiers: UInt32; inHotKeyID: EventHotKeyID; inTarget: EventTargetRef; inOptions: OptionBits; var outRef: EventHotKeyRef): OSStatus; cdecl; external HITFwk name _PU + 'RegisterEventHotKey'; {$EXTERNALSYM RegisterEventHotKey} // in version 10.0 and later in Carbon.framework function UnregisterEventHotKey(inHotKey: EventHotKeyRef): OSStatus; cdecl; external HITFwk name _PU + 'UnregisterEventHotKey'; {$EXTERNALSYM UnregisterEventHotKey} // in version 10.0 and later in Carbon.framework function GetEventParameter(inEvent: EventRef; inName: EventParamName; inDesiredType: EventParamType; outActualType: EventParamTypePtr { can be NULL }; inBufferSize: ByteCount; outActualSize: ByteCountPtr { can be NULL }; outData: Pointer { can be NULL } ): OSStatus; cdecl; external HITFwk name _PU + 'GetEventParameter'; {$EXTERNALSYM GetEventParameter}  
×
×
  • Создать...