jvappevent.pas

East make Tray Icon in delphi

  FUpdateMetricSettings := True;
  FBiDiMode := bdLeftToRight;
  if not (csDesigning in ComponentState) then
    Application.HookMainWindow(MessageHook);
  {$ENDIF VCL}
  AppList.AddEvents(Self);
end;

destructor TJvAppEvents.Destroy;
begin
  {$IFDEF VCL}
  if not (csDesigning in ComponentState) then
    Application.UnhookMainWindow(MessageHook);
  {$ENDIF VCL}
  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;

{$IFDEF VCL}

procedure TJvAppEvents.PaintIcon;
var
  PS: TPaintStruct;
begin
  BeginPaint(Application.Handle, PS);
  try
    FreeAndNil(FCanvas);
    FCanvas := TCanvas.Create;
    try
      Canvas.Handle := PS.hDC;
      Canvas.Brush.Color := clBackground;
      if PS.fErase then
        Canvas.FillRect(PS.rcPaint);
      if Assigned(FOnPaintIcon) then
        FOnPaintIcon(Self);
    finally
      FreeAndNil(FCanvas);
    end;
  finally
    EndPaint(Application.Handle, PS);
  end;
end;

procedure TJvAppEvents.SettingsChanged;
begin
  if Assigned(FOnSettingsChanged) then
    FOnSettingsChanged(Self);
end;

function TJvAppEvents.MessageHook(var Msg: TMessage): Boolean;
begin
  Result := False;
  case Msg.Msg of
    WM_WININICHANGE:
      begin
        try
          SettingsChanged;
        except
          Application.HandleException(Self);
        end;
      end;
    WM_PAINT:
      if Assigned(FOnPaintIcon) and IsIconic(Application.Handle) then
      begin
        PaintIcon;
        Result := True;
      end;
  end;
end;

{$ENDIF VCL}

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
  {$IFDEF VCL}
  if not (csDesigning in ComponentState) then
    Result := Application.UpdateFormatSettings
  else
  {$ENDIF VCL}
    Result := FUpdateFormatSettings;
end;

procedure TJvAppEvents.SetUpdateFormatSettings(Value: Boolean);
begin
  FUpdateFormatSettings := Value;
  {$IFDEF VCL}
  if not (csDesigning in ComponentState) then
    Application.UpdateFormatSettings := Value;
  {$ENDIF VCL}
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;

{$IFDEF VisualCLX}
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;
{$ENDIF VisualCLX}


{$IFDEF VCL}

function TJvAppEvents.GetUpdateMetricSettings: Boolean;
begin
  if csDesigning in ComponentState then
    Result := FUpdateMetricSettings
  else
    Result := Application.UpdateMetricSettings;
end;

procedure TJvAppEvents.SetUpdateMetricSettings(Value: Boolean);
begin
  FUpdateMetricSettings := Value;
  if not (csDesigning in ComponentState) then
    Application.UpdateMetricSettings := Value;
end;

{$ENDIF VCL}

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;

{$IFDEF VCL}

function TJvAppEvents.GetBiDiMode: TBiDiMode;
begin
  if csDesigning in ComponentState then
    Result := FBiDiMode
  else
    Result := Application.BiDiMode;
end;

procedure TJvAppEvents.SetBiDiMode(Value: TBiDiMode);
begin
  FBiDiMode := Value;
  if not (csDesigning in ComponentState) then
    Application.BiDiMode := Value;
end;

function TJvAppEvents.GetBiDiKeyboard: string;
begin
  if csDesigning in ComponentState then
    Result := FBiDiKeyboard
  else
    Result := Application.BiDiKeyboard;
end;

function TJvAppEvents.GetNonBiDiKeyboard: string;
begin
  if csDesigning in ComponentState then
    Result := FNonBiDiKeyboard
  else
    Result := Application.NonBiDiKeyboard;
end;

procedure TJvAppEvents.SetBiDiKeyboard(const Value: string);
begin
  FBiDiKeyboard := Value;
  if not (csDesigning in ComponentState) then
    Application.BiDiKeyboard := Value;
end;

procedure TJvAppEvents.SetNonBiDiKeyboard(const Value: string);
begin
  FNonBiDiKeyboard := Value;
  if not (csDesigning in ComponentState) then
    Application.NonBiDiKeyboard := Value;
end;

{$ENDIF VCL}

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;
      {$IFDEF VCL}
      UpdateMetricSettings := FUpdateMetricSettings;
      BiDiMode := FBiDiMode;
      BiDiKeyboard := FBiDiKeyboard;
      NonBiDiKeyboard := FNonBiDiKeyboard;
      {$ENDIF VCL}
      with Mouse do
      begin
        DragImmediate := FMouseDragImmediate;
        DragThreshold := FMouseDragThreshold;
      end;
    end;
  end;
end;

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

finalization
  AppList.Free;
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.