TSpeedButton now uses MaskBlt

git-svn-id: trunk@5184 -

lcl/buttons.pp

@@ -232,7 +232,7 @@ type
     procedure CMMouseLeave(var Message: TLMessage); message CM_MouseLeave;
     procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
   protected
-    FState : TButtonState;
+    FState: TButtonState;
     function GetNumGlyphs : Integer;
     procedure GlyphChanged(Sender : TObject);
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
@@ -250,7 +250,7 @@ type
     procedure SetText(const Value: TCaption); override;
     procedure UpdateState(InvalidateOnChange: boolean); virtual;
     function GetDrawFlags: integer; virtual;
-    property MouseInControl : Boolean read FMouseInControl;
+    property MouseInControl: Boolean read FMouseInControl;
     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
     function GetActionLinkClass: TControlActionLinkClass; override;
   public
@@ -331,6 +331,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.58  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.57  2004/02/07 20:25:37  mattias
   fixed saving custom TBitBtn kind
 

lcl/include/bitmap.inc

@@ -87,10 +87,22 @@ begin
 end;
 
 procedure TBitmap.Draw(ACanvas: TCanvas; const ARect: TRect);
+var
+  UseMaskHandle: HBitmap;
 begin
+  if (ARect.Right<=ARect.Left) or (ARect.Bottom<=ARect.Top)
+  or (Width=0) or (Height=0) then exit;
   HandleNeeded;
-  if HandleAllocated then
+  if HandleAllocated then begin
-    ACanvas.CopyRect(ARect, Self.Canvas, Rect(0, 0, Width, Height));
+    //ACanvas.CopyRect(ARect, Self.Canvas, Rect(0, 0, Width, Height));
+    if Transparent then
+      UseMaskHandle:=MaskHandle
+    else
+      UseMaskHandle:=0;
+    MaskBlt(ACanvas.Handle,
+            ARect.Left,ARect.Top, ARect.Right-ARect.Left,ARect.Bottom-ARect.Top,
+            Canvas.Handle,0,0, UseMaskHandle,0,0);
+  end;
 end;
 
 constructor TBitmap.Create;
@@ -1042,6 +1054,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.62  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.61  2004/02/08 11:31:32  mattias
   TMenuItem.Bitmap is now auto created on read. Added TMenuItem.HasBitmap
 

lcl/include/buttonglyph.inc

@@ -82,16 +82,20 @@ Function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
   const Offset: TPoint;  State: TButtonState;  Transparent: Boolean;
   BiDiFlags: Longint): TRect;
 var
-  gWidth : integer;
+  gWidth: integer;
-  gHeight : integer;
+  gHeight: integer;
-  DestRect: TRect;
+  DestRect, SrcRect: TRect;
   ImgID: integer;
+  UseMaskHandle: HBitmap;
 begin
-  if FOriginal = nil then Exit;
+  Result:=Client;
-  if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
+  if (FOriginal = nil) then exit;
+
+  gWidth := FOriginal.Width;
+  gHeight := FOriginal.Height;
+  if (gWidth = 0) or (gHeight = 0)
+  or (Client.Left>=Client.Right) or (Client.Top>=Client.Bottom) then Exit;
   
-  gWidth := TPixMap(FOriginal).Width;
-  gHeight := TPixMap(FOriginal).Height;
   if NumGlyphs > 1 then
     gWidth := gWidth div NumGlyphs;
     
@@ -102,19 +106,29 @@ begin
     bsExclusive: if NumGlyphs>3 then ImgID:=3;
   end;
 
-  Result := Rect((ImgID*gWidth), 0, ((ImgID+1)*gWidth), gHeight);
+  SrcRect := Rect((ImgID*gWidth), 0, ((ImgID+1)*gWidth), gHeight);
   DestRect:=Client;
   inc(DestRect.Left,Offset.X);
   inc(DestRect.Top,Offset.Y);
-  If DestRect.Right > DestRect.Left + Result.Right - Result.Left then
+  If DestRect.Right > DestRect.Left + SrcRect.Right - SrcRect.Left then
-    DestRect.Right := DestRect.Left + Result.Right - Result.Left;
+    DestRect.Right := DestRect.Left + SrcRect.Right - SrcRect.Left;
   If DestRect.Bottom > DestRect.Top + gHeight then
     DestRect.Bottom := DestRect.Top + gHeight;
-  If (Result.Right - Result.Left) <> (DestRect.Right - DestRect.Left) then
+  If (SrcRect.Right - SrcRect.Left) <> (DestRect.Right - DestRect.Left) then
-    Result.Right := Result.Left + DestRect.Right - DestRect.Left;
+    SrcRect.Right := SrcRect.Left + DestRect.Right - DestRect.Left;
-  If (Result.Bottom - Result.Top) <> (DestRect.Bottom - DestRect.Top) then
+  If (SrcRect.Bottom - SrcRect.Top) <> (DestRect.Bottom - DestRect.Top) then
-    Result.Bottom := Result.Top + DestRect.Bottom - DestRect.Top;
+    SrcRect.Bottom := SrcRect.Top + DestRect.Bottom - DestRect.Top;
-  Canvas.Copyrect(DestRect, TPixmap(FOriginal).Canvas, Result)
+
+  //Canvas.CopyRect(DestRect, FOriginal.Canvas, SrcRect)
+  UseMaskHandle:=FOriginal.MaskHandle;
+  MaskBlt(Canvas.Handle,
+          DestRect.Left,DestRect.Top,
+          DestRect.Right-DestRect.Left,DestRect.Bottom-DestRect.Top,
+          FOriginal.Canvas.Handle,SrcRect.Left,SrcRect.Top,
+          UseMaskHandle,SrcRect.Left,SrcRect.Top);
+
+  // ToDo: VCL returns the text rectangle
+  Result:=SrcRect;
 end;
 
 

lcl/include/canvas.inc

@@ -67,24 +67,26 @@ Procedure TCanvas.CopyRect(const Dest: TRect; SrcCanvas: TCanvas;
 var
   SH, SW, DH, DW: Integer;
 Begin
-//this SHOULD stretch the image to the new canvas, but it doesn't yet.....
   Assert(False, Format('Trace:==> [TCanvas.CopyRect] ', []));
-  if SrcCanvas<> nil then begin
+  if SrcCanvas= nil then exit;
-    SrcCanvas.RequiredState([csHandleValid, csBrushValid]);
-    RequiredState([csHandleValid, csBrushValid]);
 
-    SH := Source.Bottom - Source.Top;
+  SH := Source.Bottom - Source.Top;
-    SW := Source.Right - Source.Left;
+  SW := Source.Right - Source.Left;
-    if (SH=0) and (SW=0) then exit;
+  if (SH=0) or (SW=0) then exit;
-    DH := Dest.Bottom - Dest.Top;
+  DH := Dest.Bottom - Dest.Top;
-    DW := Dest.Right - Dest.Left;
+  DW := Dest.Right - Dest.Left;
-    if (Dh=0) and (DW=0) then exit;
+  if (Dh=0) or (DW=0) then exit;
-    //writeln('TCanvas.CopyRect ',ClassName,' SRcCanvas=',SrcCanvas.ClassName,' ',
+
-    //  ' Src=',Source.Left,',',Source.Top,',',SW,',',SH,
+  Changing;
-    //  ' Dest=',Dest.Left,',',Dest.Top,',',DW,',',DH);
+  SrcCanvas.RequiredState([csHandleValid, csBrushValid]);
-    StretchBlt(FHandle, Dest.Left, Dest.Top, DW, DH,
+  RequiredState([csHandleValid, csBrushValid]);
-      SrcCanvas.FHandle, Source.Left, Source.Top, SW, SH, CopyMode);
+
-  end;
+  //writeln('TCanvas.CopyRect ',ClassName,' SRcCanvas=',SrcCanvas.ClassName,' ',
+  //  ' Src=',Source.Left,',',Source.Top,',',SW,',',SH,
+  //  ' Dest=',Dest.Left,',',Dest.Top,',',DW,',',DH);
+  StretchBlt(FHandle, Dest.Left, Dest.Top, DW, DH,
+    SrcCanvas.FHandle, Source.Left, Source.Top, SW, SH, CopyMode);
+  Changed;
 
   Assert(False, Format('Trace:<== [TCanvas.CopyRect] ', []));
 end;
@@ -1257,6 +1259,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.65  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.64  2004/02/03 08:54:09  mattias
   Frame3D rect now var again
 

lcl/include/intfbasewinapi.inc

@@ -993,16 +993,17 @@ end;
 
 function TInterfaceBase.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
   SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer;
-  Rop: DWORD): Boolean;
+  ROp: DWORD): Boolean;
 begin
-  Result := False;
+  Result := StretchMaskBlt(DestDC,X,Y,Width,Height,SrcDC,XSrc,YSrc,Width,Height,
+                           Mask,XMask,YMask,ROp);
 end;
 
-//todo: remove
 function TInterfaceBase.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
   SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer): Boolean;
 begin
-  Result := False;
+  Result := MaskBlt(DestDC,X,Y,Width,Height,SrcDC,XSrc,YSrc,
+                    Mask,XMask,YMask,SRCCOPY);
 end;
 
 function TInterfaceBase.MoveToEx(DC: HDC; X, Y: Integer;
@@ -1397,6 +1398,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.5  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.4  2004/01/10 22:34:20  mattias
   started double buffering for gtk intf
 

lcl/include/speedbutton.inc

@@ -504,7 +504,7 @@ begin
   if FFlat and Enabled
   then begin
     GetCursorPos(p);
-    FMouseInControl := not (FindDragTarget(P, True) = Self);
+    FMouseInControl := (FindDragTarget(P, True) <> Self);
     if FMouseInControl
     then Perform(CM_MOUSELEAVE,0,0)
     else Perform(CM_MOUSEENTER,0,0);
@@ -773,6 +773,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.47  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.46  2004/02/05 09:45:33  mattias
   implemented Actions for TSpeedButton, TMenuItem, TCheckBox
 

lcl/interfaces/gtk/gtkobject.inc

@@ -2584,11 +2584,12 @@ var
   end;
 
 var
-  DCOrigin: TPoint;
   NewSrcWidth: Integer;
   NewSrcHeight: Integer;
   NewWidth: Integer;
   NewHeight: Integer;
+  SrcDCOrigin: TPoint;
+  DestDCOrigin: TPoint;
 begin
   Result := IsValidDC(DestDC) and IsValidDC(SrcDC);
   {$IFDEF VerboseStretchCopyArea}
@@ -2603,15 +2604,15 @@ begin
   DestDevContext:=TDeviceContext(DestDC);
 
   with SrcDevContext do begin
-    DCOrigin:=GetDCOffset(TDeviceContext(SrcDC));
+    SrcDCOrigin:=GetDCOffset(TDeviceContext(SrcDC));
-    Inc(XSrc,DCOrigin.X);
+    Inc(XSrc,SrcDCOrigin.X);
-    Inc(YSrc,DCOrigin.Y);
+    Inc(YSrc,SrcDCOrigin.Y);
     gdk_window_get_size(PGdkWindow(Drawable),@SrcWholeWidth,@SrcWholeHeight);
   end;
   with DestDevContext do begin
-    DCOrigin:=GetDCOffset(TDeviceContext(DestDC));
+    DestDCOrigin:=GetDCOffset(TDeviceContext(DestDC));
-    Inc(X,DCOrigin.X);
+    Inc(X,DestDCOrigin.X);
-    Inc(Y,DCOrigin.Y);
+    Inc(Y,DestDCOrigin.Y);
     gdk_window_get_size(PGdkWindow(Drawable),@DestWholeWidth,@DestWholeHeight);
   end;
 
@@ -2619,7 +2620,9 @@ begin
   writeln('TgtkObject.StretchCopyArea BEFORE CLIPPING X=',X,' Y=',Y,' Width=',Width,' Height=',Height,
     ' XSrc=',XSrc,' YSrc=',YSrc,' SrcWidth=',SrcWidth,' SrcHeight=',SrcHeight,
     ' SrcDrawable=',HexStr(Cardinal(TDeviceContext(SrcDC).Drawable),8),
+    ' SrcOrigin=',SrcDCOrigin.X,',',SrcDCOrigin.Y,
     ' DestDrawable=',HexStr(Cardinal(TDeviceContext(DestDC).Drawable),8),
+    ' DestOrigin=',DestDCOrigin.X,',',DestDCOrigin.Y,
     ' Mask=',HexStr(Cardinal(Mask),8),' XMask=',XMask,' YMask=',YMask,
     ' SizeChange=',SizeChange,' ROpIsSpecial=',ROpIsSpecial,
     ' DestWhole=',DestWholeWidth,',',DestWholeHeight,
@@ -9189,6 +9192,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.465  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.464  2004/02/07 18:04:14  mattias
   fixed grids OnDrawCells
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -5938,31 +5938,6 @@ begin
   Assert(False, Format('trace:< [TgtkObject.LineTo] DC:0x%x, X:%d, Y:%d', [DC, X, Y]));
 end;
 
-{------------------------------------------------------------------------------
-  Function: MaskBlt
-  Params:  DestDC:                The destination devicecontext
-           X, Y:                  The left/top corner of the destination rectangle
-           Width, Height:         The size of the destination rectangle
-           SrcDC:                 The source devicecontext
-           XSrc, YSrc:            The left/top corner of the source rectangle
-           Mask:                  The handle of a monochrome bitmap
-           XMask, YMask:          The left/top corner of the mask rectangle
-           ROp:                   The raster operation to be performed
-  Returns: True if succesful
-
-  The MaskBlt function copies a bitmap from a source context into a destination
-  context using the specified mask and raster operation.
- ------------------------------------------------------------------------------}
-function TgtkObject.MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
-  SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer;
-  ROp: DWORD): Boolean;
-begin
-  Result:=StretchMaskBlt(DestDC,X,Y,Width,Height,
-                         SrcDC,XSrc,YSrc,Width,Height,
-                         Mask,XMask,YMask,
-                         ROp);
-end;
-
 {------------------------------------------------------------------------------
   Function: MessageBox
   Params:  hWnd:                  The handle of parent window
@@ -8707,6 +8682,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.328  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.327  2004/02/04 22:17:09  mattias
   removed workaround VirtualCreate
 

lcl/interfaces/gtk/gtkwinapih.inc

@@ -140,7 +140,6 @@ function IsWindowVisible(handle: HWND): boolean; override;
 Procedure LeaveCriticalSection(var CritSection: TCriticalSection); Override;
 function LineTo(DC: HDC; X, Y: Integer): Boolean; override;
 
-function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
 function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; override;
 function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
 function MoveWindowOrgEx(DC: HDC; dX, dY: Integer): Boolean; override;
@@ -214,6 +213,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
 { =============================================================================
 
   $Log$
+  Revision 1.87  2004/02/10 00:05:03  mattias
+  TSpeedButton now uses MaskBlt
+
   Revision 1.86  2004/02/03 08:54:09  mattias
   Frame3D rect now var again