terender.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

unit teRender;

// The ZeroMem32 and MoveMem32 algorithms are from Robert Lee. You can browse his
// 'Delphi Optimizations' website at http://www.econos.com/optimize

interface

{$INCLUDE teDefs.inc}

uses 
  {$IFDEF WIN32}
  Windows, Messages,
  {$ENDIF WIN32}
  SysUtils, Classes, Consts,
  {$ifdef CLX}
  QT, QForms, QGraphics, QControls;
  {$else}
  Forms, Graphics, Controls;
  {$endif CLX}

const
  teAuto           = $00000000;
  tePaint          = $00000001;
  tePrint          = $00000002;
  teEmulate        = $00000003;
  teCallback       = $00000004;
  teHook           = $00000005;
  teThemed         = $08000000;
  tePaintCopy      = $10000000;
{$ifndef TE_NOHLP}
  teRefreshFocused = $20000000;
{$endif TE_NOHLP}
  teOwnCanvas      = $40000000;
  teNoRender       = $80000000;

type
{$ifndef TE_NOHLP}
  TDWordArray = array[0..32767] of DWord;
  PDWordArray = ^TDWordArray;
  TTEProcessorInfo = record
    MMX,
    SSE: Boolean;
  end;

  TTEWinVersion = (teWin32s, teWin95, teWin98, teWin98SE, teWinNT,  //V33
                   teWin2000, teWinME, teWinXP, teWinFuture, teWinUnknown);

  {$ifndef D5UP}
  TCustomFormClass = class of TCustomForm;
  {$endif D5UP}
{$endif TE_NOHLP}

  TTEPaintCallback = procedure(Control: TWinControl; DC: HDC);

  procedure AdjustBmpForTransition(Bmp: TBitmap;
    {$ifndef CLX}Palette: HPALETTE;{$endif CLX}
    Width, Height: Integer; PixelFormat: TPixelFormat);
{$ifndef TE_NOHLP}
  function  ControlClientOffset(Control: TControl): TPoint;
  function  ControlClientOrigin(Control: TControl): TPoint;
  function  ControlScreenToClient(Control: TControl; Point: TPoint): TPoint;
  function  ControlClientToScreen(Control: TControl; Point: TPoint): TPoint;
  function  ControlClientRect(Control: TControl): TRect;
  function  ControlClientHeight(Control: TControl): Integer;
  function  ControlClientWidth(Control: TControl): Integer;
{$endif TE_NOHLP}
  function  DeviceBitsPerPixel(
    Recalculate: Boolean{$ifdef DP} = False{$endif}): Integer;
  function  DevicePixelFormat(
    Recalculate: Boolean{$ifdef DP} = False{$endif}): TPixelFormat;

  function FormIsAlpha(Ctrl: TControl): Boolean; //V33

  function  GetBytesPerScanline(Bitmap: TBitmap; PixelFormat: TPixelFormat;
    Alignment: Longint{$ifdef DP} = 32{$endif}): Longint;
{$ifndef TE_NOHLP}
  function  GetPixelFormatBPP(PixelFormat: TPixelFormat): Integer;
  function  GetBitmapGap(Bitmap: TBitmap; PixelFormat: TPixelFormat): Integer;
  function  GetMaximizedMDIChild(WinControl: TWinControl): Boolean;
{$endif TE_NOHLP}
  function  GetSnapShotImage(R: TRect; PixelFormat: TPixelFormat): TBitmap;
{$ifndef TE_NOHLP}
  function  GetSolidColorImage(Control: TControl; Width, Height: Integer;
    Color: TColor; Palette: HPALETTE; PixelFormat: TPixelFormat): TBitmap;
{$endif TE_NOHLP}
  {$ifndef D5UP}
  function  GetWindowRgn(hWnd: HWND; hRgn: HRGN): Integer; stdcall;
  {$endif D5UP}
{$ifndef TE_NOHLP}
  function  IsScrollBarVisible(Control: TControl; Window: HWND;
    Kind: TScrollBarKind): Boolean;
  function IsWindowClipped(Window: HWND; AvoidWnd: HWND; R: TRect): Boolean;//V34
{$endif TE_NOHLP}
  function  PalettedDevice(
    Recalculate: Boolean{$ifdef DP} = False{$endif}): Boolean;
  function  RGBDevice(Recalculate: Boolean{$ifdef DP} = False{$endif}): Boolean;
{$ifndef TE_NOHLP}
  function  RealizeControlPalette(Control: TControl;
    ForceBackground: Boolean): Boolean;
  procedure RefreshWindows(Window: HWND);
{$endif TE_NOHLP}
  procedure RegisterTEControl(const ControlClassName: String;
    NonClientRenderMode, ClientRenderMode: DWord;
    RefreshNonClient, RefreshClient: Boolean);
  procedure RegisterTEControlCallback(const ControlClassName: String;
    NonClientRenderMode, ClientRenderMode: DWord;
    RefreshNonClient, RefreshClient: Boolean;
    NonClientCallback, ClientCallback: TTEPaintCallback);
  function  RenderControl(Control: TControl; R: TRect;
    ClientCoordinates, CheckRegion: Boolean; PixelFormat: TPixelFormat): TBitmap;
{$ifndef TE_NOHLP}
  function RenderWindowToBmp(
    Window, Limit: {$ifndef CLX}HWND{$else}TWidgetControl{$endif CLX};
    WinControl: TWinControl;
    R: TRect; ClientCoordinates, CheckRegion: Boolean;
    PixelFormat: TPixelFormat): TBitmap;
  procedure RenderWindowToDC(
    Window, Limit: {$ifndef CLX}HWND{$else}TWidgetControl{$endif CLX};
    WinControl: TWinControl;
    DC: {$ifndef CLX}HDC{$else}QPixmapH{$endif CLX};
    R: TRect; ClientCoordinates, CheckRegion: Boolean);
  procedure ZeroMem32(P: Pointer; Size: Integer);
  procedure MoveMem32(Src,Dest:Pointer;Size:integer);
  function ClassInheritsFrom(const ClassType: TClass;
    const ClassName: String): Boolean;
  function GetWinVersion: TTEWinVersion; //V33
  function IsWinXPUp: Bool;
{$endif TE_NOHLP}
  function  BilleniumEffectsVersion: String;

{$ifndef TE_NOHLP}
var
  CurBmp: TBitmap = nil;
  TEProcessorInfo: TTEProcessorInfo;
{$endif TE_NOHLP}

implementation

uses
  {$ifndef D3C3} FlatSB, {$endif D3C3}
  {$ifdef D7UP} Themes, {$endif D7UP}
  TypInfo, OleCtrls, ActiveX, RichEdit;

const
  RCF_PRINTNC          = $00000001;
  RCF_PAINTNC          = $00000002;
  RCF_EMULNC           = $00000004;
  RCF_CALLBACKNC       = $00000008;
  RCF_HOOKNC           = $00000010;
  RCF_PRINT            = $00000020;
  RCF_PAINT            = $00000040;
  RCF_EMUL             = $00000080;
  RCF_CALLBACK         = $00000100;
  RCF_HOOK             = $00000200;
  RCF_THEMEDNC         = $00200000;
  RCF_PAINTCOPYNC      = $00400000;
  RCF_PAINTCOPY        = $00800000;
  RCF_OWNCANVASNC      = $01000000;
  RCF_OWNCANVAS        = $02000000;
  RCF_RENDERNC         = $04000000;
  RCF_RENDER           = $08000000;
  RCF_REFRESHFOCUSEDNC = $10000000;
  RCF_REFRESHFOCUSED   = $20000000;
  RCF_REFRESHNC        = $40000000;
  RCF_REFRESH          = $80000000;

  RCF_SAVE_NOREFRESH   = $FFFFFFEF;
  RCF_SAVE_REFRESHNC   = $FFFFFFDF;
  RCF_SAVE_REFRESHC    = $FFFFFFCF;
  RCF_SAVE_REFRESHALL  = $FFFFFFBF;

  RCF_RENDERNCMASK     = $0000001F;
  RCF_RENDERMASK       = $000003E0;

type
  TTEControl    = class(TControl);
  TTEWinControl = class(TWinControl);
  TTECustomForm = class(TCustomForm);

  TTERegControl = class(TObject)
  public
    Flags: DWord;
    NonClientCallback,
    ClientCallback: TTEPaintCallback;

    constructor Create(FlagsValue: Integer;
      NonClientCallbackValue, ClientCallbackValue: TTEPaintCallback);
    procedure Assign(Source: TTERegControl);
  end;

  TTERegControls = class(TStringList)
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure FindRegControl(Control: TWinControl; ControlClass: TControlClass;
      var Data: TTERegControl);
    procedure SaveRegControl(ControlClassName: String; Flags: Integer;
      NonClientCallback, ClientCallback: TTEPaintCallback);
  end;

  TImportJumP  = packed record
    JMP: Word;
    Proc: ^Pointer;
  end;
  PImportJump = ^TImportJump;

var
  FDevicePixelFormat: TPixelFormat;
  FDeviceBitsPerPixel: Integer;
  TERegControls: TTERegControls;
  HookDC: HDC;
  HookControl: TWinControl;

{ Global routines }

function CreateIdentityPalette: HPALETTE;
var
  DC: HDC;
  SysPalSize: Integer;
  Pal: TMaxLogPalette;
begin
  DC := GetDC(0);
  try
    SysPalSize := GetDeviceCaps(DC, SIZEPALETTE);
    Pal.palVersion := $300;
    Pal.palNumEntries := SysPalSize;
    GetSystemPaletteEntries(DC, 0, SysPalSize, Pal.palPalEntry);
    Result := CreatePalette(PLogPalette(@Pal)^);
  finally
    ReleaseDC(0, DC);
  end;
end;

{$ifdef Trial}
{$include trial\taux5.inc}
{$endif Trial}

procedure AdjustBmpForTransition(Bmp: TBitmap;
  {$ifndef CLX}Palette: HPALETTE;{$endif CLX}
  Width, Height: Integer; PixelFormat: TPixelFormat);
begin
  Bmp.PixelFormat := PixelFormat;
  case PixelFormat of
    pf1bit : Bmp.Monochrome := True;
    {$ifndef CLX}
    pf8bit : begin
               if Palette = 0
               then Bmp.Palette := CreateIdentityPalette
               else Bmp.Palette := Palette;
             end;
    {$endif CLX}
  end;
  Bmp.Width  := Width;
  Bmp.Height := Height;
end;

// Returns the offset of the client area within the control
function ControlClientOffset(Control: TControl): TPoint;
var
  {$ifdef CLX}
  P: TPoint;
  {$else}
  R: TRect;
  {$endif CLX}
begin
  if Control is TWinControl
  then
  begin
    Result := ControlClientOrigin(Control);
    {$ifdef CLX}
    P := Point(0, 0);
    QWidget_mapToGlobal(TWinControl(Control).Handle, @P, @P);
    Dec(Result.X, P.X);
    Dec(Result.Y, P.Y);
    {$else}
    GetWindowRect(TWinControl(Control).Handle, R);
    Dec(Result.X, R.Left);
    Dec(Result.Y, R.Top);
    {$endif CLX}
  end
  else
  begin
    Result.X := 0;
    Result.Y := 0;
  end;
end;

// Returns the client area origin in screen coordinates
function ControlClientOrigin(Control: TControl): TPoint;
begin
  Result := Control.ClientOrigin;
end;

// Maps the given point in screen coordinates to Control coordinates
function ControlScreenToClient(Control: TControl; Point: TPoint): TPoint;
begin
  Result := Control.ScreenToClient(Point);
end;

// Maps the given point in Control coordinates to screen coordinates
function ControlClientToScreen(Control: TControl; Point: TPoint): TPoint;
begin
  Result := Control.ClientToScreen(Point);
end;

// Returns the control client area
function ControlClientRect(Control: TControl): TRect;
begin
  Result := Control.ClientRect;
end;

function ControlClientHeight(Control: TControl): Integer;
begin
  with ControlClientRect(Control) do
    Result := Bottom - Top;
end;

function ControlClientWidth(Control: TControl): Integer;
begin
  with ControlClientRect(Control) do
    Result := Right - Left;
end;

function DeviceBitsPerPixel(Recalculate: Boolean): Integer;
var
  DC: HDC;
begin
  if Recalculate then
  begin
    DC := GetDC(0);
    try
      FDeviceBitsPerPixel :=
        GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL);
    finally
      ReleaseDC(0, DC);
    end;
  end;
  Result := FDeviceBitsPerPixel;
end;

{$ifndef CLX}
function Check16bpp: TPixelFormat;
var
  hdcDisplay,
  hdcBitmap: HDC;
  Bitmap,
  OldBitmap: HBitmap;
  Green: Byte;
  Count: Integer;
  PrevGPixel: DWord;
  PrevPixel,
  NewPixel: TColorRef;
begin
  hdcDisplay := GetDC(0);
  hdcBitmap  := CreateCompatibleDC(hdcDisplay);
  Bitmap := CreateCompatibleBitmap(hdcDisplay, 10, 10);
  OldBitmap := SelectObject(hdcBitmap, Bitmap);

  PrevGPixel := 255;
  Count := 0;
  for Green := 0 to 255 do
  begin
    NewPixel := RGB(0, Green, 0);
    SetPixel(hdcBitmap, 1, 1, NewPixel);
    PrevPixel  := GetPixel(hdcBitmap, 1, 1);
    if GetGValue(PrevPixel) <> PrevGPixel then
      Inc(Count);
    PrevGPixel := GetGValue(PrevPixel);
  end;
  if Count > 32
  then Result := pf16bit
  else Result := pf15bit;

  SelectObject(hdcBitmap, OldBitmap);
  DeleteObject(Bitmap);
  DeleteDC(hdcBitmap);
  ReleaseDC(0, hdcDisplay);
end;
{$endif CLX}

function DevicePixelFormat(Recalculate: Boolean): TPixelFormat;
begin
  {$ifndef CLX}
  case DeviceBitsPerPixel(Recalculate) of
    1  : FDevicePixelFormat := pf1bit;
    4  : FDevicePixelFormat := pf4bit;
    8  : FDevicePixelFormat := pf8bit;
    15 : FDevicePixelFormat := pf15bit;
    16 : if Recalculate then
           FDevicePixelFormat := Check16bpp;
    24 : FDevicePixelFormat := pf24bit;
    32 : FDevicePixelFormat := pf32bit;
    else FDevicePixelFormat := pf24bit;
  end;
  {$else}
  case DeviceBitsPerPixel(Recalculate) of
    1  : FDevicePixelFormat := pf1bit;
    8  : FDevicePixelFormat := pf8bit;
    16 : FDevicePixelFormat := pf16bit;             
    32 : FDevicePixelFormat := pf32bit;
    else FDevicePixelFormat := pf32bit;
  end;
  {$endif CLX}         
  Result := FDevicePixelFormat;
end;

//V33
function FormIsAlpha(Ctrl: TControl): Boolean;
const
  WS_EX_LAYERED =  $00080000;
Begin
  Result:= (GetWindowLong(GetParentForm(Ctrl).Handle,GWL_EXSTYLE) And WS_EX_LAYERED)<>0;
end;

function GetBytesPerScanline(Bitmap: TBitmap;
  PixelFormat: TPixelFormat;
  Alignment: Longint): Longint;
var
  PixelsPerScanline: Longint;
begin
  {$ifndef CLX}
  if PixelFormat in [pfDevice, pfCustom] then
  begin
    Result := 0;
    exit;
  end;
  {$endif CLX}
  PixelsPerScanline := Bitmap.Width;
  Dec(Alignment);
  Result := ((PixelsPerScanline * GetPixelFormatBPP(PixelFormat) + Alignment)
    and not Alignment) div 8;
end;

function GetPixelFormatBPP(PixelFormat: TPixelFormat): Integer;
const
  {$ifndef CLX}
  BitCounts: array [pf1Bit..pf32Bit] of Byte = (1,4,8,16,16,24,32);
  {$else}
  BitCounts: array [pf1Bit..pf32Bit] of Byte = (1,8,16,32);
  {$endif CLX}
begin
  if PixelFormat <> pfCustom