aqmaskforms.pas

AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题

      Exit;
    case Msg.Msg of
      WM_MOUSEMOVE:
        if not DragFinished then
          DoMouseMove(State, P.X, P.Y);
      WM_CAPTURECHANGED:
        EndDrag(True);
      WM_LBUTTONUP:
        DoMouseUp(mbLeft, State, P.X, P.Y);
      WM_RBUTTONUP:
        DoMouseUp(mbRight, State, P.X, P.Y);
      WM_MBUTTONUP:
        DoMouseUp(mbMiddle, State, P.X, P.Y);
      WM_LBUTTONDOWN:
        DoMouseDown(mbLeft, State, P.X, P.Y);
      WM_RBUTTONDOWN:
        DoMouseDown(mbRight, State, P.X, P.Y);
      WM_MBUTTONDOWN:
        DoMouseDown(mbMiddle, State, P.X, P.Y);
      CN_KEYDOWN:
        if Msg.WParam = VK_ESCAPE then
        begin
          EndDrag(False);
          Msg.Result := 1;
        end
        else if not DragFinished then
        begin
          DoMouseMove(State, P.X, P.Y);
          Msg.Result := 1;
        end;
      CN_KEYUP:
        if not DragFinished then
        begin
          if Msg.WParam = VK_SHIFT then Exclude(State, ssShift);
          if Msg.WParam = VK_CONTROL then Exclude(State, ssCtrl);
          DoMouseMove(State, P.X, P.Y);
          Msg.Result := 1;
        end;
    end;
  except
    EndDrag(False);
  end;
end;

{$ENDIF}

function TaqCustomMaskForm.SupportsRegions: Boolean;
begin
  Result := False;
end;

{ TaqTranslucentMaskForm }

function TaqTranslucentMaskForm.ClientToScreen(P: TPoint): TPoint;
begin
  Result := FForm.ClientToScreen(P);
end;

procedure TaqTranslucentMaskForm.DoCreateMask;
begin
  FForm := GetFormClass.CreateNew(nil);
  with TCustomFormFriend(FForm) do
  begin
    OnDeactivate := FormDeactivate;
    OnMouseMove := FormMouseMove;
    OnMouseUp := FormMouseUp;
    OnMouseDown := FormMouseDown;
    OnKeyDown := FormKeyDown;
    OnKeyUp := FormKeyUp;
    OnPaint := FormPaint;
    OnShow := FormShow;
  end;
end;

procedure TaqTranslucentMaskForm.DoDestroyMask;
var
  frm: TCustomForm;
begin
  if FForm <> nil then
  begin
     // Handle incoming messages queue.
    Application.ProcessMessages;
     // Free form safely.
    frm := FForm;
    FForm := nil;
    frm.Release;
  end;
  SetRegion(aqNullHandle);
end;

procedure TaqTranslucentMaskForm.FormDeactivate(Sender: TObject);
begin
  if not FDragFinished and not Destroyed and Visible then
    EndDrag(False);
end;

procedure TaqTranslucentMaskForm.FormKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  P: TPoint;
begin
  if DragFinished or Destroyed then
    Exit;
  if (Key = keyEsc) and (Shift = []) then
    EndDrag(False)
  else
  begin
    Assert(not FDestroyed);
    if GetCursorPos(P) then
    begin
      P := FForm.ScreenToClient(P);
      DoMouseMove(Shift + FLastMouseState, P.X, P.Y);
    end;
  end;
end;

procedure TaqTranslucentMaskForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  P: TPoint;
begin
  if DragFinished or Destroyed then
    Exit;
  Assert(not FDestroyed);
  if GetCursorPos(P) then
  begin
    P := FForm.ScreenToClient(P);
    Shift := Shift + FLastMouseState;
    if Key = keyCtrl then Exclude(Shift, ssCtrl);
    if Key = keyShift then Exclude(Shift, ssShift);
    DoMouseMove(Shift, P.X, P.Y);
  end;
end;

procedure TaqTranslucentMaskForm.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if DragFinished or Destroyed then
    Exit;
  Shift := Shift + aqButtonToShiftState(Button);
  FLastMouseState := Shift;
  DoMouseDown(Button, Shift, X, Y);
end;

procedure TaqTranslucentMaskForm.FormMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if DragFinished or Destroyed then
    Exit;
  FLastMouseState := Shift;
  DoMouseMove(Shift, X, Y);
end;

procedure TaqTranslucentMaskForm.FormMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if DragFinished or Destroyed then
    Exit;
  if Button = mbLeft then
    Exclude(Shift, ssLeft);
  if Button = mbRight then
    Exclude(Shift, ssRight);
  if Button = mbMiddle then
    Exclude(Shift, ssMiddle);
  FLastMouseState := Shift;
  DoMouseUp(Button, Shift, X, Y);
end;

procedure TaqTranslucentMaskForm.FormPaint(Sender: TObject);
begin
  if not (DragFinished or Destroyed) then
    DoPaint;
end;

function TaqTranslucentMaskForm.GetBoundsRect: TRect;
begin
  Result := FForm.BoundsRect;
end;

function TaqTranslucentMaskForm.GetHeight: Integer;
begin
  Result := FForm.Height;
end;

function TaqTranslucentMaskForm.GetVisible: Boolean;
begin
  Result := FForm.Visible;
end;

function TaqTranslucentMaskForm.GetWidth: Integer;
begin
  Result := FForm.Width;
end;

procedure TaqTranslucentMaskForm.SetBoundsRect(const Value: TRect);
begin
  FForm.BoundsRect := Value;
end;

procedure TaqTranslucentMaskForm.SetVisible(const Value: Boolean);
begin
  FForm.Visible := Value;
end;

constructor TaqTranslucentMaskForm.Create;
begin
  inherited Create;
  FLastMouseState := [];
end;

procedure TaqTranslucentMaskForm.FormShow(Sender: TObject);
begin
  if not (DragFinished or Destroyed) then
    DoCaptureFocus;
end;

procedure TaqTranslucentMaskForm.SetRegion(const Value: TaqHandle);
var
  Rgn: TaqHandle;
begin
  if not aqEqualRgn(Value, FRegion) then
  begin
    Rgn := FRegion;
    if Value <> aqNullHandle then
      FRegion := aqDuplicateRegion(Value)
    else
      FRegion := Value;
    if FForm <> nil then
    begin
      if aqGetRegionComplexity(Value) <> aqRegionSimple then
        SetWindowRgn(FForm.Handle, aqDuplicateRegion(Value), True)
      else if aqGetRegionComplexity(Rgn) <> aqRegionSimple then
        SetWindowRgn(FForm.Handle, aqNullHandle, True);
    end;
    if Rgn <> aqNullHandle then
      DeleteObject(Rgn);
  end;
end;

function TaqTranslucentMaskForm.GetRegion: TaqHandle;
begin
  Result := FRegion;
end;

function TaqTranslucentMaskForm.SupportsRegions: Boolean;
begin
  Result := True;
end;

procedure TaqTranslucentMaskForm.DoCaptureFocus;
begin
  if not Captured and Visible then
  begin
    SetCaptureControl(FForm);
    inherited DoCaptureFocus;
  end;
end;

procedure TaqTranslucentMaskForm.DoReleaseFocus;
begin
  if Captured then
  begin
    inherited DoReleaseFocus;
    SetCaptureControl(nil);
  end;
end;

procedure TaqTranslucentMaskForm.DoFrameSizeChanged;
begin
  if FForm <> nil then
    FForm.Invalidate;
end;

{ TaqSplitterForm }

constructor TaqSplitterForm.Create;
begin
  inherited;
  Orientation := spoVertical;
  FMinCoord := -1; FMaxCoord := -1; FCurrentCoord := -1;
end;

procedure TaqSplitterForm.DoEndDrag(Successful: Boolean);
begin
  inherited DoEndDrag(Successful);
  Screen.Cursor := crDefault;
  if Successful and Assigned(FOnSplitterDrop) then
    FOnSplitterDrop(FitInBounds(FMinCoord, FMaxCoord, FCurrentCoord));
  Release;
end;

function TaqSplitterForm.FitInBounds(ALeft, ARight,
  AValue: Integer): Integer;
begin
  Result := AValue;
  if Result > ARight then
    Result := ARight
  else if Result < ALeft then
    Result := ALeft;
end;

procedure TaqSplitterForm.DoMouseMove(Shift: TShiftState; X, Y: Integer);
var
  Coord: TPoint;
  R: TRect;
begin
  Coord := ClientToScreen(Point(X, Y));
  R := BoundsRect;
  if FOrientation = spoVertical then
  begin
    FCurrentCoord := FitInBounds(FMinCoord, FMaxCoord, Coord.Y);
    OffsetRect(R, 0, FCurrentCoord - R.Top);
  end
  else
  begin
    FCurrentCoord := FitInBounds(FMinCoord, FMaxCoord, Coord.X);
    OffsetRect(R, FCurrentCoord - R.Left, 0);
  end;
  BoundsRect := R;

  if not (ssLeft in Shift) then
    EndDrag(True);
end;

procedure TaqSplitterForm.DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    EndDrag(True);
end;

procedure TaqSplitterForm.DrawFrame;
var
  PaintedWindow: HWND;
  DC: HDC;
  OldBrush: HBrush;
  TopLeft, Size: TPoint;
begin
  if not Captured then Exit;
  TopLeft := FDrawRect.TopLeft;
  Size := Point(FDrawRect.Right - FDrawRect.Left, FDrawRect.Bottom - FDrawRect.Top);

  if SplitterParent = nil then
  begin
    PaintedWindow := GetDesktopWindow;
    DC := GetDCEx(PaintedWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
  end
  else
  begin
    PaintedWindow := FSplitterParent.Handle;
    DC := GetDCEx(PaintedWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
    TopLeft := FSplitterParent.ScreenToClient(TopLeft);
  end;

  try
    OldBrush := SelectObject(DC, FBrush.Handle);
    PatBlt(DC, TopLeft.X, TopLeft.Y, Size.X, Size.Y, PATINVERT);
    SelectObject(DC, OldBrush);
  finally
    ReleaseDC(PaintedWindow, DC);
  end;
end;

procedure TaqSplitterForm.SetBoundsRect(const Value: TRect);
begin
  if not FInitialized then
  begin
    if Orientation = spoVertical then
    begin
      FrameSize := (Value.Bottom - Value.Top) div 2;
      FCurrentCoord := Value.Top + FrameSize;
    end
    else
    begin
      FrameSize := (Value.Right - Value.Left) div 2;
      FCurrentCoord := Value.Left + FrameSize;
    end;
    FInitialized := True;
  end;
  inherited SetBoundsRect(Value);
end;

procedure TaqSplitterForm.SetCursor(const Value: TCursor);
begin
  if FCursor <> Value then
  begin
    FCursor := Value;
    Screen.Cursor := Value;
  end;
end;

{$IFNDEF VCL}

{ TaqCLXMaskForm }

procedure TaqCLXMaskForm.DoCaptureFocus;
begin
  if not Captured and FForm.Visible then
  begin
    SetCaptureControl(FForm);
    if QWidget_keyboardGrabber <> nil then
       QWidget_releaseKeyboard(QWidget_keyboardGrabber);
    QWidget_grabKeyboard(FForm.Handle);
    inherited;
  end;
end;

procedure TaqCLXMaskForm.DoCreateMask;
begin
  inherited;
  with TaqMaskedForm(FForm) do
  begin
    BorderStyle := fbsNone;
    OnDrawMask := FormDrawMask;
    Color := clDark;
    Masked := True;
    FormStyle := fsStayOnTop;
  end;
end;

procedure TaqCLXMaskForm.FormDrawMask(Sender: TCustomForm;
  ACanvas: TCanvas);
var
  R: TRect;
begin
  if DragFinished then
    Exit;
  R := Sender.ClientRect;
  ACanvas.Brush.Color := clDontMask;
  ACanvas.FillRect(R);

  ACanvas.Brush.Color := clMask;
  InflateRect(R, -FrameSize, -FrameSize);
  ACanvas.FillRect(R);
end;

procedure TaqCLXMaskForm.DoFrameSizeChanged;
begin
  inherited;
  TaqMaskedForm(FForm).UpdateMask;
end;

function TaqCLXMaskForm.GetFormClass: TCustomFormClass;
begin
  Result := TaqMaskedForm;
end;

procedure TaqCLXMaskForm.DoReleaseFocus;
begin
  if Captured then
  begin
    SetCaptureControl(nil);
    if QWidget_keyboardGrabber <> nil then
       QWidget_releaseKeyboard(QWidget_keyboardGrabber);
    inherited;
  end;
end;

procedure TaqCLXMaskForm.SetVisible(const Value: Boolean);
begin
  inherited;
   // Dummy fix for visibility change.
  if Value then
  begin
    FForm.Visible := False;
    FForm.Visible := True;
    DoCaptureFocus;
  end;
end;

{ TaqMaskedForm }

procedure TaqMaskedForm.DoDrawMask(ACanvas: TCanvas);
begin
  if Assigned(FOnDrawMask) then FOnDrawMask(Self, ACanvas);
end;

function TaqMaskedForm.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;

procedure TaqMaskedForm.InitWidget;
var
  FOldMasked: Boolean;
begin
  FOldMasked := Masked;
  inherited;
  Masked := FOldMasked;
end;

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

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

procedure TaqMaskedForm.Resize;
begin
  if Masked then
    UpdateMask;
  inherited;
end;

procedure TaqMaskedForm.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;
    Canvas.Start(False);
    try
      Canvas.Handle := QP;
      DoDrawMask(Canvas);
    finally
      Canvas.Stop;
      Canvas.ReleaseHandle;
      QPainter_Destroy(QP);
      Canvas.Free;
    end;
    QWidget_setMask(Handle, QB);
  finally
    QBitmap_destroy(QB);
  end;
end;

{$ENDIF}

end.