File: lclext.inc

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (61 lines) | stat: -rw-r--r-- 1,873 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61


function CreateBitmapMask(BitmapDC: HDC; Width, Height: Integer; TransparentColor: TColor): HBITMAP;
var
  OldColor: COLORREF;
  OldObj: HBITMAP;
  MaskDC: HDC;
begin
  Result := Windows.CreateBitmap(Width,Height,1,1,nil);
  MaskDC := Windows.CreateCompatibleDC(BitmapDC);
  
  OldObj := Windows.SelectObject(MaskDC,Result);
  OldColor := Windows.SetBkColor(BitmapDC, Windows.COLORREF(ColorToRGB(TransparentColor)));

  Windows.BitBlt(MaskDC,0,0,Width,Height,BitmapDC,0,0,SRCCOPY);

  Windows.SetBkColor(BitmapDC,OldColor);
  Windows.SelectObject(MaskDC,OldObj);
  Windows.DeleteDC(MaskDC);
end;

function DirectMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Mask: HBITMAP): Boolean;
var
  MaskDC: HDC;
  MaskObj: HGDIOBJ;
  PrevTextColor, PrevBkColor: COLORREF;
begin
  //this is a stripped version of LCL.StretchMaskBlt
  if Mask <> 0 then
  begin
    MaskDC := Windows.CreateCompatibleDC(DestDC);
    MaskObj := Windows.SelectObject(MaskDC, Mask);

    PrevTextColor := Windows.SetTextColor(DestDC, $00000000);
    PrevBkColor := Windows.SetBkColor(DestDC, $00FFFFFF);
    
    Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
    Windows.BitBlt(DestDC, X, Y, Width, Height, MaskDC, XSrc, YSrc, SRCAND);
    Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC,  XSrc, YSrc, SRCINVERT);
    
    Windows.SetTextColor(DestDC, PrevTextColor);
    Windows.SetBkColor(DestDC, PrevBkColor);
    Windows.SelectObject(MaskDC, MaskObj);
    Windows.DeleteDC(MaskDC);
  end
  else
    Result := Windows.BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, SRCCOPY);
end;

function OptimalPixelFormat: TPixelFormat;
begin
  if ScreenInfo.ColorDepth = 32 then
    Result := pf32bit
  else
    Result := pfDevice;
end;

function OSSupportsUTF16: Boolean;
begin
  Result := Win32Platform = VER_PLATFORM_WIN32_NT;
end;