appevent.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

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

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

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

{$IFDEF RX_D4}

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

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

procedure TAppEventList.DoShortCut(var Msg: TWMKey; var Handled: Boolean);
var
  I: Integer;
begin
  for I := FAppEvents.Count - 1 downto 0 do begin
    if Assigned(TAppEvents(FAppEvents[I]).FOnShortCut) then
      TAppEvents(FAppEvents[I]).FOnShortCut(Msg, Handled);
    if not TAppEvents(FAppEvents[I]).Chained or Handled then Exit;
  end;
  if Assigned(FOnShortCut) then FOnShortCut(Msg, Handled);
end;

{$ENDIF RX_D4}

const
  AppList: TAppEventList = nil;

{ TAppEvents }

constructor TAppEvents.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AppList = nil then AppList := TAppEventList.Create;
  FChained := True;
  FHintColor := DefHintColor;
  FHintPause := DefHintPause;
  FShowHint := True;
{$IFDEF RX_D3}
  FUpdateMetricSettings := True;
{$ENDIF}
{$IFDEF WIN32}
  FHintShortPause := DefHintShortPause;
  FHintHidePause := DefHintHidePause;
  FShowMainForm := True;
{$ENDIF}
{$IFDEF RX_D4}
  FHintShortCuts := True;
  FBiDiMode := bdLeftToRight;
  FMouseDragImmediate := True;
  FMouseDragThreshold := 5;
{$ENDIF}
  FUpdateFormatSettings := True;
  if not (csDesigning in ComponentState) then
    Application.HookMainWindow(MessageHook);
  AppList.AddEvents(Self);
end;

destructor TAppEvents.Destroy;
begin
  if not (csDesigning in ComponentState) then
    Application.UnhookMainWindow(MessageHook);
  if Self <> nil then AppList.RemoveEvents(Self);
  FCanvas.Free;
  inherited Destroy;
end;

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

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

procedure TAppEvents.PaintIcon;
var
  PS: TPaintStruct;
begin
  BeginPaint(Application.Handle, PS);
  try
    if FCanvas <> nil then FCanvas.Free;
    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
      FCanvas.Free;
      FCanvas := nil;
    end;
  finally
    EndPaint(Application.Handle, PS);
  end;
end;

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

function TAppEvents.MessageHook(var Msg: TMessage): Boolean;
begin
  Result := False;
  case Msg.Msg of
    WM_WININICHANGE:
      begin
{$IFNDEF WIN32}
        if UpdateFormatSettings then GetFormatSettings;
{$ELSE}
  {$IFNDEF RX_D3}
        if Application.ShowHint then begin
          Application.ShowHint := False;
          Application.ShowHint := True;
        end;
  {$ENDIF}
{$ENDIF}
        try
          SettingsChanged;
        except
          Application.HandleException(Self);
        end;
      end;
{$IFNDEF WIN32}
    WM_ENDSESSION: if WordBool(Msg.wParam) then Halt;
{$ENDIF}
    WM_PAINT:
      if Assigned(FOnPaintIcon) and IsIconic(Application.Handle) then
      begin
        PaintIcon;
        Result := True;
      end;
  end;
end;

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

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

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

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

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

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

function TAppEvents.GetUpdateFormatSettings: Boolean;
begin
{$IFDEF WIN32}
  if (csDesigning in ComponentState) then Result := FUpdateFormatSettings
  else Result := Application.UpdateFormatSettings;
{$ELSE}
  Result := FUpdateFormatSettings;
{$ENDIF}
end;

procedure TAppEvents.SetUpdateFormatSettings(Value: Boolean);
begin
  FUpdateFormatSettings := Value;
{$IFDEF WIN32}
  if not (csDesigning in ComponentState) then
    Application.UpdateFormatSettings := Value;
{$ENDIF}
end;

{$IFDEF WIN32}

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

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

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

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

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

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

{$ENDIF WIN32}

{$IFDEF RX_D3}

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

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

{$ENDIF RX_D3}

{$IFDEF RX_D4}

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

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

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

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

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

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

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

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

{$ENDIF RX_D4}

{$IFDEF RX_D5}

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

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

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

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

{$ENDIF RX_D5}

procedure TAppEvents.UpdateAppProps;
begin
  if not (csDesigning in ComponentState) then begin
    with Application do begin
      HintColor := FHintColor;
      HintPause := FHintPause;
      ShowHint := FShowHint;
{$IFDEF WIN32}
      HintShortPause := FHintShortPause;
      HintHidePause := FHintHidePause;
      ShowMainForm := FShowMainForm;
      UpdateFormatSettings := FUpdateFormatSettings;
{$ENDIF}
{$IFDEF RX_D3}
      UpdateMetricSettings := FUpdateMetricSettings;
{$ENDIF}
{$IFDEF RX_D4}
      HintShortCuts := FHintShortCuts;
      BiDiMode := FBiDiMode;
      with Mouse do begin
        DragImmediate := FMouseDragImmediate;
        DragThreshold := FMouseDragThreshold;
      end;
{$ENDIF}
{$IFDEF RX_D5}
      BiDiKeyboard := FBiDiKeyboard;
      NonBiDiKeyboard := FNonBiDiKeyboard;      
{$ENDIF}
    end;
  end;
end;

procedure DestroyLocals; far;
begin
  if AppList <> nil then begin
    AppList.Free;
    AppList := nil;
  end;
end;

initialization
{$IFDEF WIN32}
finalization
  DestroyLocals;
{$ELSE}
  AddExitProc(DestroyLocals);
{$ENDIF}
end.