home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / INFO / DI9901RV.ZIP / PlgBltU.pas
Pascal/Delphi Source File  |  1998-12-14  |  3KB  |  115 lines
  1. unit PlgBltU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Math;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Img: TImage;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.     procedure FormPaint(Sender: TObject);
  15.     procedure FormMouseMove(Sender: TObject;
  16.       Shift: TShiftState; X,Y: Integer);
  17.   private
  18.     P          : array[0..3] of TPoint;
  19.     OAng       : array[0..3] of Double;
  20.     OverHandle : Integer;
  21.     BkBmp      : TBitmap;
  22.     MidPt      : TPoint;
  23.     Ang,R      : Double;
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. procedure TForm1.FormCreate(Sender: TObject);
  34. var
  35.   Pt : Integer;
  36. begin
  37.   BkBmp := TBitmap.Create;
  38.   BkBmp.Width := Width;
  39.   BkBmp.Height := Height;
  40.   P[0] := Img.BoundsRect.TopLeft;
  41.   P[3] := Img.BoundsRect.BottomRight;
  42.   P[1] := P[0]; Inc(P[1].X,Img.Width);
  43.   P[2] := P[3]; Dec(P[2].X,Img.Width);
  44.   with Img do 
  45.     MidPt := Point(Left+Width div 2,Top + Height div 2);
  46.   with Img do 
  47.     R := SqRt(Sqr(Width div 2) + Sqr(Height div 2));
  48.   for Pt := 0 to 3 do 
  49.     with P[Pt] do
  50.       OAng[Pt]:= ArcTan2(Y-MidPt.Y,X-MidPt.X)+Pi;
  51.   OverHandle := -1;
  52. end;
  53.  
  54. procedure TForm1.FormDestroy(Sender: TObject);
  55. begin
  56.   BkBmp.Free;
  57. end;
  58.  
  59. procedure TForm1.FormPaint(Sender: TObject);
  60. var
  61.   Pt : Integer;
  62. begin
  63.   with BkBmp.Canvas do begin
  64.     Brush.Color := clBtnFace;
  65.     FillRect(ClipRect);
  66.     if PlgBlt(Handle,P,Img.Canvas.Handle,0,0,
  67.               Img.Width,Img.Height,0,0,0) then
  68.       begin
  69.         Brush.Color := clBlack;
  70.         for Pt := 0 to 3 do 
  71.           with P[Pt] do
  72.             FillRect(Rect(X-3,Y-3,X+3,Y+3));
  73.       end
  74.     else
  75.       TextOut(0,0,'PlgBlt supported only on WinNT');
  76.   end;
  77.   Canvas.Draw(0,0,BkBmp);
  78. end;
  79.  
  80. procedure TForm1.FormMouseMove(Sender: TObject;
  81.   Shift: TShiftState; X,Y: Integer);
  82. var
  83.   Pt      : Integer;
  84.   TmpRect : TRect;
  85. begin
  86.   if ssLeft in Shift then
  87.     begin
  88.       if OverHandle = -1 then
  89.         Exit;
  90.       Ang := ArcTan2(Y-MidPt.Y,X-MidPt.X) - 
  91.                OAng[OverHandle]+Pi;
  92.       for Pt := 0 to 3 do
  93.         P[Pt] := Point(MidPt.X-Round(R*Cos(Ang+OAng[Pt])),
  94.                        MidPt.Y-Round(R*Sin(Ang+OAng[Pt])));
  95.       Paint;
  96.     end
  97.   else
  98.     begin
  99.       OverHandle := -1;
  100.       for Pt := 0 to 3 do begin
  101.         with P[Pt] do 
  102.           TmpRect := Rect(X-3,Y-3,X+3,Y+3);
  103.         if PtInRect(TmpRect,Point(X,Y)) then
  104.           begin
  105.             Cursor := crHandPoint;
  106.             OverHandle := Pt;
  107.           end;
  108.       end;
  109.       if OverHandle = -1 then
  110.         Cursor := crDefault;
  111.     end;
  112. end;
  113.  
  114. end.
  115.