Draw заголовок раздела перетащите изображение - PullRequest
Новая
       8

Draw заголовок раздела перетащите изображение

4 голосов
/ 03 августа 2011

Я использую Delphi 2006.

У меня есть пользовательский элемент управления заголовком, который я написал с нуля. Он почти закончен, за исключением того, что я не знаю, как нарисовать полупрозрачное изображение перетаскивания раздела заголовка, когда пользователь перетаскивает раздел заголовка, чтобы изменить его положение.

THeaderControl в Delphi делает это довольно хорошо, однако это подкласс элемента управления заголовком Windows, мой нет, он написан с нуля. Поэтому мне было интересно, есть ли функция Windows, которая рисует это для вас, или вы должны сделать это самостоятельно.

Спасибо

1 Ответ

1 голос
/ 03 августа 2011

Реализация GetDragImages. Например. следующим образом: 

type
  THeader = class(TCustomControl)
  private
    FColWidth: Integer;
    FDragImages: TDragImageList;
    FDragIndex: Integer;
    FDragPos: TPoint;
  protected
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    function GetDragImages: TDragImageList; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ THeader }

constructor THeader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csDisplayDragImage];
  DragCursor := crNone;
  FColWidth := 100;
end;

procedure THeader.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  FreeAndNil(FDragImages);
  // Eat inherited if you do not publish the default drag events
end;

procedure THeader.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  // Eat inherited if you do not publish the default drag events
  Accept := Source = Self;
end;

function THeader.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
  begin
    FDragImages := TDragImageList.Create(nil);
    Bmp := TBitmap.Create;
    try
      Bmp.Width := FColWidth;
      Bmp.Height := Height;
      BitBlt(Bmp.Canvas.Handle, 0, 0, FColWidth, Height, Canvas.Handle,
        FDragIndex * FColWidth, 0, SRCCOPY);
      FDragImages.Width := FColWidth;
      FDragImages.Height := Height;
      FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), FDragPos.X,
        FDragPos.Y);
    finally
      Bmp.Free;
    end;
  end;
  Result := FDragImages;
end;

procedure THeader.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  FDragIndex := X div FColWidth;
  FDragPos.X := X mod FColWidth;
  FDragPos.Y := Y;
end;

procedure THeader.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if ssLeft in Shift then
    BeginDrag(False, Mouse.DragThreshold);
end;

procedure THeader.Paint;
var
  i: Integer;
  R: TRect;
begin
  for i := 0 to 3 do
  begin
    SetRect(R, i * FColWidth, 0, (i + 1) * FColWidth, Height);
    Canvas.Brush.Color := clSilver;
    Canvas.Font.Color := clWhite;
    DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONPUSH or
      DFCS_PUSHED or DFCS_ADJUSTRECT);
    Canvas.TextRect(R, R.Left + 2, R.Top + 2, 'Column ' + IntToStr(i + 1));
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  with THeader.Create(Self) do
  begin
    SetBounds(0, 100, 500, 30);
    Parent := Self;
  end;
end;

И если вы не хотите вертикального перемещения перетаскиваемого изображения (как в стандартном THeaderControl), вам придется перестраивать перетаскиваемое изображение при каждом перемещении мыши. См. Перетаскивание изменения изображения при перетаскивании ... .

...