aqdockingutils.pas

来自「AutomatedDocking Library 控件源代码修改 适合Delp」· PAS 代码 · 共 2,359 行 · 第 1/5 页

  Canvas.FillRect(R);
  Canvas.Brush.Color := clDontMask;
  if ControlCount > 0 then
    for I := 0 to ControlCount - 1 do
    begin
      Canvas.Brush.Color := clDontMask;
      R := Controls[I].BoundsRect;
      Canvas.FillRect(R);
    end;
end;

function TaqCustomControl.EventFilter(Sender: QObjectH;
  Event: QEventH): Boolean;
begin
  Result := inherited EventFilter(Sender, Event);
  case QEvent_type(Event) of
    QEventType_Resize,
    QEventType_FocusIn,
    QEventType_FocusOut:
      UpdateMask;
  end;
end;

function TaqCustomControl.GetAlignDisabled: Boolean;
const
{$IFDEF LINUX}
  CAlignLevelOffset = $13C;
{$ELSE}
  CAlignLevelOffset = $12C;
{$ENDIF}
begin
   // Fix for TWidgetControl: CLX guys forgot to define AlignDisabled property,
   // and we have to hack the private field FAlignLevel.
   // NOTE: This should be removed as soon as TWdigetControl will be fixed.
  Result := PWord(Cardinal(Pointer(Self)) + CAlignLevelOffset)^ > 0;
end;

function TaqCustomControl.GetCanvas: TCanvas;
begin
  Assert(FCanvas <> nil);
  Result := FCanvas;
end;

procedure TaqCustomControl.Invalidate;
begin
  inherited Invalidate;
  UpdateMask;
end;

procedure TaqCustomControl.MaskChanged;
begin
  if Masked then
    UpdateMask
  else
    QWidget_clearMask(Handle);
end;

procedure TaqCustomControl.Paint;
begin
  // By default, fill client rect with default Brush.
  Canvas.Brush := Brush;
  Canvas.FillRect(ClientRect);
end;

procedure TaqCustomControl.Painting(Sender: QObjectH;
  EventRegion: QRegionH);
begin
  TaqControlCanvas(FCanvas).DoubleBuffered := DoubleBuffered;
  TaqControlCanvas(FCanvas).StartPaint;
  try
    QPainter_setClipRegion(FCanvas.Handle, EventRegion);
    Paint;
  finally
    TaqControlCanvas(FCanvas).StopPaint;
  end;
end;

procedure TaqCustomControl.PaletteChanged(Sender: TObject);
begin
  // We disable palette updating to perform all painting in
  // the Paint method.
end;

procedure TaqCustomControl.UpdateMask;
var
  QB: QBitmapH;
  QP: QPainterH;
  Canvas: TCanvas;
begin
  if not Masked or not HandleAllocated then Exit;
  QB := QBitmap_create(Width, Height, True, QPixmapOptimization_DefaultOptim);
  try
    QP := QPainter_create(QB, Handle);
    Canvas := TCanvas.Create;
    try
      Canvas.Start(False);
      Canvas.Handle := QP;
      DrawMask(Canvas);
      Canvas.Stop;
    finally
      // QP is destroying here and becomes invalid after
      Canvas.Free;
    end;
    QWidget_setMask(Handle, QB);
  finally
    QBitmap_destroy(QB);
  end;
end;
{$ENDIF}

{$IFNDEF VCL}

{ TaqControlCanvas }

procedure TaqControlCanvas.BeginPainting;
begin
  if not QPainter_isActive(Handle) then
    if FDoubleBuffered and (Control <> nil) then
    begin
      FBitmap := TBitmap.Create;
      FBitmap.Handle := QPixmap_create(Control.Width, Control.Height, -1,
        QPixmapOptimization_DefaultOptim);
      Assert(Control is TWidgetControl);
      if not QPainter_begin(Handle, FBitmap.Handle, TWidgetControl(Control).Handle) then
        raise EInvalidGraphicOperation.Create(SInvalidCanvasState);
    end;
  inherited;
end;

destructor TaqControlCanvas.Destroy;
begin
  FreeAndNil(FBitmap);
  inherited;
end;

procedure TaqControlCanvas.StopPaint;
begin
  if (StartCount = 1) and FDoubleBuffered and (Control <> nil) and
    QPainter_isActive(FHandle) then
    bitBlt(TControlFriend(Control).GetPaintDevice, 0, 0, FBitmap.Handle, 0, 0, FBitmap.Width,
      FBitmap.Height, RasterOp_CopyROP, False);
  inherited StopPaint;
  if (StartCount = 0) and FDoubleBuffered and (Control <> nil) then
    FreeAndNil(FBitmap);
end;

{ TaqApplicationEvents }

procedure TaqApplicationEvents.Activate;
begin
  if Assigned(MultiCaster) then
    MultiCaster.Activate(Self);
end;

procedure TaqApplicationEvents.CancelDispatch;
begin
  if Assigned(MultiCaster) then
    MultiCaster.CancelDispatch;
end;

constructor TaqApplicationEvents.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if Assigned(MultiCaster) then
    MultiCaster.AddAppEvent(Self);
end;

procedure TaqApplicationEvents.DoActionExecute(Action: TBasicAction;
  var Handled: Boolean);
begin
  if Assigned(FOnActionExecute) then FOnActionExecute(Action, Handled);
end;

procedure TaqApplicationEvents.DoActionUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  if Assigned(FOnActionUpdate) then FOnActionUpdate(Action, Handled);
end;

procedure TaqApplicationEvents.DoActivate(Sender: TObject);
begin
  if Assigned(FOnActivate) then FOnActivate(Sender);
end;

procedure TaqApplicationEvents.DoDeactivate(Sender: TObject);
begin
  if Assigned(FOnDeactivate) then FOnDeactivate(Sender);
end;

procedure TaqApplicationEvents.DoException(Sender: TObject;
  E: Exception);
begin
  if not (E is EAbort) and Assigned(FOnException) then
    FOnException(Sender, E)
end;

function TaqApplicationEvents.DoHelp(HelpType: THelpType; HelpContext: THelpContext; 
 const HelpKeyword: String; const HelpFile: String; var Handled: Boolean): Boolean;
begin
  if Assigned(FOnHelp) then
    Result := FOnHelp(HelpType, HelpContext, HelpKeyword, HelpFile, Handled)
  else
    Result := False;
end;

procedure TaqApplicationEvents.DoHint(Sender: TObject);
begin
  if Assigned(FOnHint) then
    FOnHint(Sender)
  else
    with THintAction.Create(Self) do
    try
      Hint := Application.Hint;
      Execute;
    finally
      Free;
    end;
end;

procedure TaqApplicationEvents.DoIdle(Sender: TObject; var Done: Boolean);
begin
  if Assigned(FOnIdle) then FOnIdle(Sender, Done);
end;

procedure TaqApplicationEvents.DoMinimize(Sender: TObject);
begin
  if Assigned(FOnMinimize) then FOnMinimize(Sender);
end;

procedure TaqApplicationEvents.DoRestore(Sender: TObject);
begin
  if Assigned(FOnRestore) then FOnRestore(Sender);
end;

procedure TaqApplicationEvents.DoShortcut(Key: Integer; Shift: TShiftState;
  var Handled: Boolean);
begin
  if Assigned(FOnShortcut) then FOnShortcut(Key, Shift, Handled);
end;

procedure TaqApplicationEvents.DoShowHint(var HintStr: WideString;
  var CanShow: Boolean; var HintInfo: THintInfo);
begin
  if Assigned(FOnShowHint) then FOnShowHint(HintStr, CanShow, HintInfo);
end;

procedure TaqApplicationEvents.DoModalBegin(Sender: TObject);
begin
  if Assigned(FOnModalBegin) then FOnModalBegin(Sender);
end;

procedure TaqApplicationEvents.DoModalEnd(Sender: TObject);
begin
  if Assigned(FOnModalEnd) then FOnModalEnd(Sender);
end;

{ TMultiCaster }

procedure TMultiCaster.Activate(AppEvent: TaqApplicationEvents);
begin
  if CheckDispatching(AppEvent) and
    (FAppEvents.IndexOf(AppEvent) < FAppEvents.Count - 1) then
  begin
    FAppEvents.Remove(AppEvent);
    FAppEvents.Add(AppEvent);
  end;
end;

procedure TMultiCaster.AddAppEvent(AppEvent: TaqApplicationEvents);
begin
  if FAppEvents.IndexOf(AppEvent) = -1 then
    FAppEvents.Add(AppEvent);
end;

procedure TMultiCaster.BeginDispatch;
begin
  Inc(FDispatching);
end;

procedure TMultiCaster.CancelDispatch;
begin
  FCancelDispatching := True;
end;

function TMultiCaster.CheckDispatching(AppEvents: TaqApplicationEvents): Boolean;
begin
  Result := FDispatching = 0;
  if not Result then
    FCacheAppEvent := AppEvents;
end;

constructor TMultiCaster.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAppEvents := TComponentList.Create(False);
  with Application do
  begin
    OnActionExecute := DoActionExecute;
    OnActionUpdate := DoActionUpdate;
    OnActivate := DoActivate;
    OnDeactivate := DoDeactivate;
    OnException := DoException;
    OnHelp := DoHelp;
    OnHint := DoHint;
    OnIdle := DoIdle;
    OnMinimize := DoMinimize;
    OnRestore := DoRestore;
    OnShowHint := DoShowHint;
    OnShortCut := DoShortcut;
    OnModalBegin := DoModalBegin;
    OnModalEnd := DoModalEnd;
  end;
end;

destructor TMultiCaster.Destroy;
begin
  MultiCaster := nil;
  with Application do
  begin
    OnActionExecute := nil;
    OnActionUpdate := nil;
    OnActivate := nil;
    OnDeactivate := nil;
    OnException := nil;
    OnHelp := nil;
    OnHint := nil;
    OnIdle := nil;
    OnMinimize := nil;
    OnRestore := nil;
    OnShowHint := nil;
    OnShortCut := nil;
    OnModalBegin := nil;
    OnModalEnd := nil;
  end;
  FAppEvents.Free;
  inherited Destroy;
end;

procedure TMultiCaster.DoActionExecute(Action: TBasicAction; var Handled: Boolean);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoActionExecute(Action, Handled);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoActionUpdate(Action: TBasicAction; var Handled: Boolean);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoActionUpdate(Action, Handled);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoActivate(Sender: TObject);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoActivate(Sender);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoDeactivate(Sender: TObject);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoDeactivate(Sender);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoException(Sender: TObject; E: Exception);
var
  I: Integer;
  FExceptionHandled: Boolean;
begin
  BeginDispatch;
  FExceptionHandled := False;
  try
    for I := Count - 1 downto 0 do
    begin
      if Assigned(AppEvents[I].OnException) then
      begin
        FExceptionHandled := True;
        AppEvents[I].DoException(Sender, E);
        if FCancelDispatching then Break;
      end;
    end;
  finally
    if not FExceptionHandled then
      if not (E is EAbort) then
        Application.ShowException(E);
    EndDispatch;
  end;
end;

function TMultiCaster.DoHelp(HelpType: THelpType; HelpContext: THelpContext;
  const HelpKeyword: String; const HelpFile: String; var Handled: Boolean): Boolean;
var
  I: Integer;
begin
  BeginDispatch;
  try
    Result := False;
    for I := Count - 1 downto 0 do
    begin
      Result := Result or AppEvents[I].DoHelp(HelpType, HelpContext, HelpKeyword, HelpFile, Handled);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoHint(Sender: TObject);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoHint(Sender);
      if FCancelDispatching then Break;
    end;
  finally
    EndDispatch;
  end;
end;

procedure TMultiCaster.DoIdle(Sender: TObject; var Done: Boolean);
var
  I: Integer;
begin
  BeginDispatch;
  try
    for I := Count - 1 downto 0 do
    begin
      AppEvents[I].DoIdle(Sender, Done);
      i