paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 06:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

TSpeedButton now uses MaskBlt

Browse Source 
git-svn-id: trunk@5184 -
This commit is contained in:
mattias 2004-02-10 00:05:03 +00:00
parent 63221956e2
commit c1592f9af8
9 changed files with 103 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/buttons.pp
View File

@ -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

19
lcl/include/bitmap.inc
View File

@ -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
ACanvas.CopyRect(ARect, Self.Canvas, Rect(0, 0, Width, Height));
if HandleAllocated then begin
//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

44
lcl/include/buttonglyph.inc
View File

@ -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;
gHeight : integer;
DestRect: TRect;
gWidth: integer;
gHeight: integer;
DestRect, SrcRect: TRect;
ImgID: integer;
UseMaskHandle: HBitmap;
begin
if FOriginal = nil then Exit;
if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
Result:=Client;
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
DestRect.Right := DestRect.Left + Result.Right - Result.Left;
If DestRect.Right > DestRect.Left + SrcRect.Right - SrcRect.Left then
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
Result.Right := Result.Left + DestRect.Right - DestRect.Left;
If (Result.Bottom - Result.Top) <> (DestRect.Bottom - DestRect.Top) then
Result.Bottom := Result.Top + DestRect.Bottom - DestRect.Top;
Canvas.Copyrect(DestRect, TPixmap(FOriginal).Canvas, Result)
If (SrcRect.Right - SrcRect.Left) <> (DestRect.Right - DestRect.Left) then
SrcRect.Right := SrcRect.Left + DestRect.Right - DestRect.Left;
If (SrcRect.Bottom - SrcRect.Top) <> (DestRect.Bottom - DestRect.Top) then
SrcRect.Bottom := SrcRect.Top + DestRect.Bottom - DestRect.Top;
//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;

37
lcl/include/canvas.inc
View File

@ -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
SrcCanvas.RequiredState([csHandleValid, csBrushValid]);
RequiredState([csHandleValid, csBrushValid]);
if SrcCanvas= nil then exit;
SH := Source.Bottom - Source.Top;
SW := Source.Right - Source.Left;
if (SH=0) and (SW=0) then exit;
DH := Dest.Bottom - Dest.Top;
DW := Dest.Right - Dest.Left;
if (Dh=0) and (DW=0) then exit;
//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);
end;
SH := Source.Bottom - Source.Top;
SW := Source.Right - Source.Left;
if (SH=0) or (SW=0) then exit;
DH := Dest.Bottom - Dest.Top;
DW := Dest.Right - Dest.Left;
if (Dh=0) or (DW=0) then exit;
Changing;
SrcCanvas.RequiredState([csHandleValid, csBrushValid]);
RequiredState([csHandleValid, csBrushValid]);
//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

12
lcl/include/intfbasewinapi.inc
View File

@ -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

5
lcl/include/speedbutton.inc
View File

@ -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

20
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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));
Inc(XSrc,DCOrigin.X);
Inc(YSrc,DCOrigin.Y);
SrcDCOrigin:=GetDCOffset(TDeviceContext(SrcDC));
Inc(XSrc,SrcDCOrigin.X);
Inc(YSrc,SrcDCOrigin.Y);
gdk_window_get_size(PGdkWindow(Drawable),@SrcWholeWidth,@SrcWholeHeight);
end;
with DestDevContext do begin
DCOrigin:=GetDCOffset(TDeviceContext(DestDC));
Inc(X,DCOrigin.X);
Inc(Y,DCOrigin.Y);
DestDCOrigin:=GetDCOffset(TDeviceContext(DestDC));
Inc(X,DestDCOrigin.X);
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

28
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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

4
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -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