lazarus-ccr/components/orpheus/ovcdrag.pas

{*********************************************************}
{*                   OVCDRAG.PAS 4.06                    *}
{*********************************************************}

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Orpheus                                    *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002    *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

{$I OVC.INC}

{$B-} {Complete Boolean Evaluation}
{$I+} {Input/Output-Checking}
{$P+} {Open Parameters}
{$T-} {Typed @ Operator}
{.W-} {Windows Stack Frame}
{$X+} {Extended Syntax}

unit ovcdrag;

interface

uses
  {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF} 
  Classes, Graphics;

type
  TOvcDragShow = class(TObject)
  {.Z+}
  protected
    dStretchBltMode   : Integer;
    dMemDC,dSMemDC,
    dDstDC,dSaveDC    : hDC;
    dSaveBmp, dMemBmp,
    dSMemBmp          : hBITMAP;
    dcrText, dcrBack  : TColorRef;
    dRect             : TRect;
    dSize             : TPoint;
    dSystemPalette16  : hPalette;
    dOldPal           : hPalette;
    Bitmap,dMask      : TBitmap;
    DeltaX, DeltaY    : Integer;
    dDragging,
    dHaveOriginal     : Boolean;

    procedure ilDragDraw;
    procedure ilRestoreOriginal;
    procedure ilSaveOriginal;

  public
    constructor Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
    destructor Destroy;
      override;
    procedure DragMove(X, Y : Integer);
    procedure HideDragImage;
    procedure ShowDragImage;
  {.Z+}
  end;


implementation


{*** TOvcDragShow ***}

constructor TOvcDragShow.Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
var
  dMaskDC : HDC;
  SrcDC : HDC;
begin
  dHaveOriginal := False;
  dDstDC := GetDC(0);
  DeltaX := X - SourceRect.Left;
  DeltaY := Y - SourceRect.Top;
  dec(X, DeltaX);
  dec(Y, DeltaY);
  dRect.Left := X;
  dRect.Top := Y;
  Bitmap := nil;
  dMask := nil;
  try
    Bitmap := TBitmap.Create;
    Bitmap.Width := SourceRect.Right - SourceRect.Left + 1;
    Bitmap.Height := SourceRect.Bottom - SourceRect.Top + 1;

    dMask := TBitmap.Create;
    dMask.Width := SourceRect.Right - SourceRect.Left + 1;
    dMask.Height := SourceRect.Bottom - SourceRect.Top + 1;

    BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, dDstDC, SourceRect.Left,
      SourceRect.Top, SRCCOPY);
{$IFNDEF LCL}
    dMask.Canvas.BrushCopy(Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
      Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
{$ELSE}
    BrushCopy(dMask.Canvas, Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
      Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
{$ENDIF}

    dMemDC := CreateCompatibleDC(0);
    dSaveDC := CreateCompatibleDC(0);
    dDragging := True;
    dStretchBltMode := SetStretchBltMode(dDstDC, BLACKONWHITE);
    dSize.X := Bitmap.Width;
    dSize.Y := Bitmap.Height;
    dRect.Right := dRect.Left + dSize.X - 1;
    dRect.Bottom := dRect.Top + dSize.Y - 1;
    SrcDC := Bitmap.Canvas.Handle;
    dMaskDC := dMask.Canvas.Handle;
    dSMemDC := CreateCompatibleDC(dMaskDC);
    dMemBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
    SelectObject(dMemDC, dMemBmp);
    dSMemBmp := CreateCompatibleBitmap(dMaskDC, dSize.X, dSize.Y);
    SelectObject(dSMemDC, dSMemBmp);
    dSaveBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
    SelectObject(dSaveDC, dSaveBmp);
    dSystemPalette16 := GetStockObject(DEFAULT_PALETTE);
    dOldPal := SelectPalette(SrcDC, dSystemPalette16, False);
    SelectPalette(SrcDC, dOldPal, False);
    if dOldPal <> 0 then begin
      SelectPalette(dMemDC, dOldPal, True);
      SelectPalette(dSaveDC, dOldPal, True);
    end else begin
      SelectPalette(dMemDC, dSystemPalette16, True);
      SelectPalette(dSaveDC, dSystemPalette16, True);
    end;
    RealizePalette(dMemDC);
    RealizePalette(dSaveDC);

    BitBlt(dSMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
    BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
    BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, SrcDC, 0, 0, SrcErase);
    dcrText := SetTextColor(dDstDC, $0);
    dcrBack := SetBkColor(dDstDC, $FFFFFF);
    ilSaveOriginal;
    ilDragDraw;
  except
    Bitmap.Free;
    dMask.Free;
    raise;
  end;
end;

destructor TOvcDragShow.Destroy;
begin
  ilRestoreOriginal;
  SetTextColor(dDstDC, dcrText);
  SetBkColor(dDstDC, dcrBack);
  DeleteObject(dMemBmp);
  DeleteObject(dSaveBmp);
  DeleteObject(dSMemBmp);
  DeleteDC(dMemDC);
  DeleteDC(dSMemDC);
  DeleteDC(dSaveDC);
  SetStretchBltMode(dDstDC, dStretchBltMode);
  ReleaseDC(0,dDstDC);
  dDragging := False;
  Bitmap.Free;
  dMask.Free;
  inherited Destroy;
end;

procedure TOvcDragShow.DragMove(X, Y: Integer);
var
  NewRect, Union : TRect;
  UnionSize : TPoint;
  WorkDC : hDC;
  WorkBM : hBitmap;
begin
  if not dDragging then exit;
  dec(X, DeltaX);
  dec(Y, DeltaY);
  {if we didn't move, get out}
  if (X = dRect.Left) and (Y = dRect.Top) then exit;
  {let's see where we're going}
  NewRect := Rect(X, Y, X + dSize.X - 1, Y + dSize.Y - 1);
  {if drag image not currently shown, just update next draw position and exit}
  if not dHaveOriginal then begin
    dRect := NewRect;
    exit;
  end;
  {do the old and new positions overlap?}
  if ord(IntersectRect(Union, dRect, NewRect)) <> 0 then begin
    {rect old and new combined:}
    UnionRect(Union, NewRect, dRect);
    {size of union:}
    UnionSize.X := Union.Right - Union.Left + 1;
    UnionSize.Y := Union.Bottom - Union.Top + 1;
    {create combination buffer}
    WorkDC := CreateCompatibleDC(0);
    WorkBM := CreateCompatibleBitmap(dDstDC, UnionSize.X, UnionSize.Y);
    SelectObject(WorkDC, WorkBM);
    if dOldPal <> 0 then
      SelectPalette(WorkDC, dOldPal, True)
    else
      SelectPalette(WorkDC, dSystemPalette16, True);
    RealizePalette(WorkDC);
    {copy screen section (including old image) to local buffer}
    BitBlt(WorkDC, 0, 0, UnionSize.X, UnionSize.Y, dDstDC, Union.Left, Union.Top, SRCCOPY);
    {"repair" by restoring background for old image}
    BitBlt(WorkDC, dRect.Left - Union.Left, dRect.Top - Union.Top,
       dSize.X, dSize.Y, dSaveDC, 0, 0, SRCCOPY);
    {save background so we can do the same next time}
    BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, SrcCopy);
    {write image at new position into local buffer}
    BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
    BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
    {copy combined image to screen}
    BitBlt(dDstDC, Union.Left, Union.Top, UnionSize.X, UnionSize.Y, WorkDC, 0, 0, SRCCOPY);
    dRect := NewRect;
    DeleteDC(WorkDC);
    DeleteObject(WorkBM);
  end else begin
    {images dont overlap, so we might as well do the draw in two steps}
    ilRestoreOriginal;
    dRect := NewRect;
    ilSaveOriginal;
    ilDragDraw;
  end;
end;

procedure TOvcDragShow.HideDragImage;
begin
  ilRestoreOriginal;
end;

procedure TOvcDragShow.ilDragDraw;
begin
  BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
  BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
end;

procedure TOvcDragShow.ilRestoreOriginal;
begin
  if not dHaveOriginal then exit;
  BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSaveDC, 0, 0, SrcCopy);
  dHaveOriginal := False;
end;

procedure TOvcDragShow.ilSaveOriginal;
begin
  BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, dDstDC, dRect.Left, dRect.Top, SrcCopy);
  dHaveOriginal := True;
end;

procedure TOvcDragShow.ShowDragImage;
begin
  ilSaveOriginal;
  ilDragDraw;
end;


end.