jvqappevent.pas

East make Tray Icon in delphi

  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnEvent) then
      TJvAppEvents(FAppEvents[I]).FOnEvent(Sender, Event, Handled);
    if not TJvAppEvents(FAppEvents[I]).Chained or Handled or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnEvent) then
    FOnEvent(Sender, Event, Handled);
end;


procedure TJvAppEventList.DoMinimize(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnMinimize) then
      TJvAppEvents(FAppEvents[I]).FOnMinimize(Sender);
    if not TJvAppEvents(FAppEvents[I]).Chained or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnMinimize) then
    FOnMinimize(Sender);
end;

procedure TJvAppEventList.DoRestore(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnRestore) then
      TJvAppEvents(FAppEvents[I]).FOnRestore(Sender);
    if not TJvAppEvents(FAppEvents[I]).Chained or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnRestore) then
    FOnRestore(Sender);
end;

procedure TJvAppEventList.DoShowHint(var HintStr: THintString; var CanShow: Boolean;
  var HintInfo: THintInfo);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnShowHint) then
      TJvAppEvents(FAppEvents[I]).FOnShowHint(HintStr, CanShow, HintInfo);
    if not TJvAppEvents(FAppEvents[I]).Chained or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnShowHint) then
    FOnShowHint(HintStr, CanShow, HintInfo);
end;

procedure TJvAppEventList.DoActiveControlChange(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnActiveControlChange) then
      TJvAppEvents(FAppEvents[I]).FOnActiveControlChange(Sender);
    if not TJvAppEvents(FAppEvents[I]).Chained or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnActiveControlChange) then
    FOnActiveControlChange(Sender);
end;

procedure TJvAppEventList.DoActiveFormChange(Sender: TObject);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnActiveFormChange) then
      TJvAppEvents(FAppEvents[I]).FOnActiveFormChange(Sender);
    if not TJvAppEvents(FAppEvents[I]).Chained or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnActiveFormChange) then
    FOnActiveFormChange(Sender);
end;


procedure TJvAppEventList.DoActionExecute(Action: TBasicAction;
  var Handled: Boolean);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnActionExecute) then
      TJvAppEvents(FAppEvents[I]).FOnActionExecute(Action, Handled);
    if not TJvAppEvents(FAppEvents[I]).Chained or Handled or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnActionExecute) then
    FOnActionExecute(Action, Handled);
end;

procedure TJvAppEventList.DoActionUpdate(Action: TBasicAction;
  var Handled: Boolean);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnActionUpdate) then
      TJvAppEvents(FAppEvents[I]).FOnActionUpdate(Action, Handled);
    if not TJvAppEvents(FAppEvents[I]).Chained or Handled or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnActionUpdate) then
    FOnActionUpdate(Action, Handled);
end;



procedure TJvAppEventList.DoShortCut(Key: Integer; Shift: TShiftState; var Handled: Boolean);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do
  begin
    TJvAppEvents(FAppEvents[I]).FCancelDispatch := False;
    if Assigned(TJvAppEvents(FAppEvents[I]).FOnShortCut) then
      TJvAppEvents(FAppEvents[I]).FOnShortCut(Key, Shift, Handled);
    if not TJvAppEvents(FAppEvents[I]).Chained or Handled or
     TJvAppEvents(FAppEvents[I]).FCancelDispatch then
      Exit;
  end;
  if Assigned(FOnShortCut) then
    FOnShortCut(Key, Shift, Handled);
end;


//=== { TJvAppEvents } =======================================================

var
  AppList: TJvAppEventList = nil;

constructor TJvAppEvents.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AppList = nil then
    AppList := TJvAppEventList.Create;

  FChained := True;
  FHintColor := DefHintColor;
  FHintPause := DefHintPause;
  FShowHint := True;
  FCancelDispatch := False;
  FHintShortPause := DefHintShortPause;
  FHintHidePause := DefHintHidePause;
  FShowMainForm := True;
  FHintShortCuts := True;
  FMouseDragImmediate := True;
  FMouseDragThreshold := 5;
  FUpdateFormatSettings := True;
  FSavedHintFont := TFont.Create;
  FSavedHintFont.assign(Screen.HintFont);
  FSavedStyle := Application.Style.DefaultStyle;

  AppList.AddEvents(Self);
end;

destructor TJvAppEvents.Destroy;
begin  
  Screen.HintFont.assign(FSavedHintFont);
  Application.Style.DefaultStyle := FSavedStyle; 

  if (Self <> nil) and (AppList <> nil) then
    AppList.RemoveEvents(Self);
  inherited Destroy;
  // (rom) destroy Canvas AFTER inherited Destroy
  FCanvas.Free;
end;

procedure TJvAppEvents.Loaded;
begin
  inherited Loaded;
  UpdateAppProps;
end;

function TJvAppEvents.GetCanvas: TCanvas;
begin
  if FCanvas = nil then
    FCanvas := TCanvas.Create;
  Result := FCanvas;
end;

procedure TJvAppEvents.CancelDispatch;
begin
  FCancelDispatch := True;
end;



function TJvAppEvents.GetHintColor: TColor;
begin
  if csDesigning in ComponentState then
    Result := FHintColor
  else
    Result := Application.HintColor;
end;

function TJvAppEvents.GetHintPause: Integer;
begin
  if csDesigning in ComponentState then
    Result := FHintPause
  else
    Result := Application.HintPause;
end;

function TJvAppEvents.GetShowHint: Boolean;
begin
  if csDesigning in ComponentState then
    Result := FShowHint
  else
    Result := Application.ShowHint;
end;

procedure TJvAppEvents.SetHintColor(Value: TColor);
begin
  FHintColor := Value;
  if not (csDesigning in ComponentState) then
    Application.HintColor := Value;
end;

procedure TJvAppEvents.SetHintPause(Value: Integer);
begin
  FHintPause := Value;
  if not (csDesigning in ComponentState) then
    Application.HintPause := Value;
end;

procedure TJvAppEvents.SetShowHint(Value: Boolean);
begin
  FShowHint := Value;
  if not (csDesigning in ComponentState) then
    Application.ShowHint := Value;
end;

function TJvAppEvents.GetUpdateFormatSettings: Boolean;
begin 
    Result := FUpdateFormatSettings;
end;

procedure TJvAppEvents.SetUpdateFormatSettings(Value: Boolean);
begin
  FUpdateFormatSettings := Value; 
end;

function TJvAppEvents.GetHintShortPause: Integer;
begin
  if csDesigning in ComponentState then
    Result := FHintShortPause
  else
    Result := Application.HintShortPause;
end;

function TJvAppEvents.GetHintHidePause: Integer;
begin
  if csDesigning in ComponentState then
    Result := FHintHidePause
  else
    Result := Application.HintHidePause;
end;

function TJvAppEvents.GetShowMainForm: Boolean;
begin
  if csDesigning in ComponentState then
    Result := FShowMainForm
  else
    Result := Application.ShowMainForm;
end;

procedure TJvAppEvents.SetHintShortPause(Value: Integer);
begin
  FHintShortPause := Value;
  if not (csDesigning in ComponentState) then
    Application.HintShortPause := Value;
end;

procedure TJvAppEvents.SetHintHidePause(Value: Integer);
begin
  FHintHidePause := Value;
  if not (csDesigning in ComponentState) then
    Application.HintHidePause := Value;
end;

procedure TJvAppEvents.SetShowMainForm(Value: Boolean);
begin
  FShowMainForm := Value;
  if not (csDesigning in ComponentState) then
    Application.ShowMainForm := Value;
end;


function TJvAppEvents.GetEffects: TUIEffects;
begin
  Result := TUIEffects(Application.Effects);
end;

procedure TJvAppEvents.SetEffects(Value: TUIEffects);
begin
  Application.Effects := TAppEffects(Value);
end;

function TJvAppEvents.GetHintFont: TFont;
begin
  Result := Screen.HintFont;
end;

procedure TJvAppEvents.SetHintFont(Value: TFont);
begin
  Screen.HintFont := Value;
end;

function TJvAppEvents.GetStyle: TDefaultStyle;
begin
  Result := Application.Style.DefaultStyle;
end;

procedure TJvAppEvents.SetStyle(Value: TDefaultStyle);
begin
  Application.Style.DefaultStyle := Value;
end;


function TJvAppEvents.GetHintShortCuts: Boolean;
begin
  if csDesigning in ComponentState then
    Result := FHintShortCuts
  else
    Result := Application.HintShortCuts;
end;

function TJvAppEvents.GetMouseDragImmediate: Boolean;
begin
  if (csDesigning in ComponentState) or (Mouse = nil) then
    Result := FMouseDragImmediate
  else
    Result := Mouse.DragImmediate;
end;

function TJvAppEvents.GetMouseDragThreshold: Integer;
begin
  if (csDesigning in ComponentState) or (Mouse = nil) then
    Result := FMouseDragThreshold
  else
    Result := Mouse.DragThreshold;
end;

procedure TJvAppEvents.SetMouseDragImmediate(Value: Boolean);
begin
  FMouseDragImmediate := Value;
  if not (csDesigning in ComponentState) and (Mouse <> nil) then
    Mouse.DragImmediate := Value;
end;

procedure TJvAppEvents.SetMouseDragThreshold(Value: Integer);
begin
  FMouseDragThreshold := Value;
  if not (csDesigning in ComponentState) and (Mouse <> nil) then
    Mouse.DragThreshold := Value;
end;

procedure TJvAppEvents.SetHintShortCuts(Value: Boolean);
begin
  FHintShortCuts := Value;
  if not (csDesigning in ComponentState) then
    Application.HintShortCuts := Value;
end;



procedure TJvAppEvents.UpdateAppProps;
begin
  if not (csDesigning in ComponentState) then
  begin
    with Application do
    begin
      HintColor := FHintColor;
      HintPause := FHintPause;
      ShowHint := FShowHint;
      HintShortPause := FHintShortPause;
      HintHidePause := FHintHidePause;
      ShowMainForm := FShowMainForm;
      HintShortCuts := FHintShortCuts;
      UpdateFormatSettings := FUpdateFormatSettings; 
      with Mouse do
      begin
        DragImmediate := FMouseDragImmediate;
        DragThreshold := FMouseDragThreshold;
      end;
    end;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQAppEvent.pas,v $';
    Revision: '$Revision: 1.18 $';
    Date: '$Date: 2005/02/06 14:06:00 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}


finalization
  AppList.Free;

  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.