xpgraphutil.pas

非常好的xp界面控件

{
 Copyright:      rhoStyle Developers team
 mailto:         [e-mail]
 Author:         rhoStyle
 Version:        2.5
 Delphi Version: Delphi 3-7
 Delphi Version: Delphi 3-7
 Description:    This is utility unit for Windows XP style controls

}
unit XPGraphUtil;


interface

uses
  Windows, Classes, Graphics, xpReg;

const
{ TBitmap.GetTransparentColor from GRAPHICS.PAS use this value }
  PaletteMask = $02000000;


type
  TFillDirection = (fdTopToBottom, fdBottomToTop, fdLeftToRight, fdRightToLeft, fdVerticalFromCenter, fdHorizFromCenter, fdXP);

//Gradint filling functions
procedure GradientFillRect(Canvas: TCanvas; ARect: TRect; StartColor,
  EndColor: TColor; Direction: TFillDirection; Colors: Byte);

procedure GradientVertLine (Canvas : TCanvas; X, Y, Len : Integer; StartColor,
  EndColor: TColor; Direction: TFillDirection; Colors: Byte);

function WidthOf(R: TRect): Integer;
function HeightOf(R: TRect): Integer;

procedure GradientXPFillRect (ACanvas : TCanvas; ARect : TRect; LightColor : TColor; DarkColor : TColor; Colors : Byte);

//Bitmap functions
procedure ConvertBitmapToGrayscale (const Bmp: TBitmap);
procedure CopyBitmap (const Source : TBitmap; Dest : TBitmap);

procedure TileImage(Canvas: TCanvas; Rect: TRect; Image: TGraphic);

procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer;
  Bitmap: TBitmap; TransparentColor: TColor);

procedure DrawBitmapRectTransparent(Dest: TCanvas; DstX, DstY: Integer;
  SrcRect: TRect; Bitmap: TBitmap; TransparentColor: TColor);

procedure StretchBitmapTransparent(Dest: TCanvas; Bitmap: TBitmap;
  TransparentColor: TColor; DstX, DstY, DstW, DstH, SrcX, SrcY,
  SrcW, SrcH: Integer);

procedure StretchBitmapRectTransparent(Dest: TCanvas; DstX, DstY, DstW,
  DstH: Integer; SrcRect: TRect; Bitmap: TBitmap; TransparentColor: TColor);

//Create region from bitmap
function CreateRegionFromBitmap(Bitmap: TBitmap; TransparentColor: TColor; Range : Integer) : hRgn;

//Create region from bitmap scaled by rectangle
function CreateRgnRectFromBitmap(Bitmap: TBitmap; ARect : TRect; TransparentColor: TColor; Range : Integer) : hRgn;

function GetSysColorCount (DC : hDC) : Integer;


procedure SmoothImage (ACanvas : TCanvas; ARect : TRect; Transparent : TColor);

//Make color darker
function MakeDarkColor (AColor : TColor; ADarkRate : Integer) : TColor;



function Max (Value1, Value2 : Integer) : Integer;
function Min (Value1, Value2 : Integer) : Integer;


implementation

procedure ConvertBitmapToGrayscale (const Bmp: TBitmap);
  {From: Pascal Enz, [e-mail] }
type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;
var
  x, y, Gray: Integer;
  Row: PRGBArray;
begin
  Bmp.PixelFormat := pf24Bit;
  for y := 0 to Bmp.Height - 1 do
  begin
    Row := Bmp.ScanLine[y];
    for x := 0 to Bmp.Width - 1 do
    begin
      Gray           := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
      Row[x].rgbtRed := Gray;
      Row[x].rgbtGreen := Gray;
      Row[x].rgbtBlue := Gray;
    end;
  end;
end;


function MakeDarkColor (AColor : TColor; ADarkRate : Integer) : TColor;
var
  R, G, B : Integer;
begin
  R := GetRValue   (ColorToRGB (AColor)) - ADarkRate;
  G := GetGValue (ColorToRGB (AColor)) - ADarkRate;
  B := GetBValue (ColorToRGB (AColor)) - ADarkRate;
  if R < 0 then R := 0;
  if G < 0 then G := 0;
  if B < 0 then B := 0;
  if R > 255 then R := 255;
  if G > 255 then G := 255;
  if B > 255 then B := 255;
  Result := TColor (RGB (R, G, B));
end;




function Max (Value1, Value2 : Integer) : Integer;
begin
  If Value1 > Value2 then Result := Value1 else Result := Value2;
end;

function Min (Value1, Value2 : Integer) : Integer;
begin
  If Value1 < Value2 then Result := Value1 else Result := Value2;
end;

function HeightOf(R: TRect): Integer;
begin
  Result := R.Bottom - R.Top;
end;

function WidthOf(R: TRect): Integer;
begin
  Result := R.Right - R.Left;
end;


procedure GradientSimpleFillRect(Canvas: TCanvas; ARect: TRect; StartColor,
  EndColor: TColor; Direction: TFillDirection; Colors: Byte);
var
  StartRGB: array[0..2] of Byte;    { Start RGB values }
  RGBDelta: array[0..2] of Integer; { Difference between start and end RGB values }
  ColorBand: TRect;                 { Color band rectangular coordinates }
  I, Delta: Integer;
  Brush: HBrush;
begin
  if IsRectEmpty(ARect) then Exit;
  if Colors < 2 then begin
    Brush := CreateSolidBrush(ColorToRGB(StartColor));
    FillRect(Canvas.Handle, ARect, Brush);
    DeleteObject(Brush);
    Exit;
  end;
  StartColor := ColorToRGB(StartColor);
  EndColor := ColorToRGB(EndColor);
  case Direction of
    fdTopToBottom, fdLeftToRight: begin
      { Set the Red, Green and Blue colors }
      StartRGB[0] := GetRValue(StartColor);
      StartRGB[1] := GetGValue(StartColor);
      StartRGB[2] := GetBValue(StartColor);
      { Calculate the difference between begin and end RGB values }
      RGBDelta[0] := GetRValue(EndColor) - StartRGB[0];
      RGBDelta[1] := GetGValue(EndColor) - StartRGB[1];
      RGBDelta[2] := GetBValue(EndColor) - StartRGB[2];
    end;
    fdBottomToTop, fdRightToLeft: begin
      { Set the Red, Green and Blue colors }
      { Reverse of TopToBottom and LeftToRight directions }
      StartRGB[0] := GetRValue(EndColor);
      StartRGB[1] := GetGValue(EndColor);
      StartRGB[2] := GetBValue(EndColor);
      { Calculate the difference between begin and end RGB values }
      { Reverse of TopToBottom and LeftToRight directions }
      RGBDelta[0] := GetRValue(StartColor) - StartRGB[0];
      RGBDelta[1] := GetGValue(StartColor) - StartRGB[1];
      RGBDelta[2] := GetBValue(StartColor) - StartRGB[2];
    end;
  end; {case}
  { Calculate the color band's coordinates }
  ColorBand := ARect;
  if Direction in [fdTopToBottom, fdBottomToTop] then begin
    Colors := Max(2, Min(Colors, HeightOf(ARect)));
    Delta := HeightOf(ARect) div Colors;
  end
  else begin
    Colors := Max(2, Min(Colors, WidthOf(ARect)));
    Delta := WidthOf(ARect) div Colors;
  end;
  with Canvas.Pen do begin { Set the pen style and mode }
    Style := psSolid;
    Mode := pmCopy;
  end;
  { Perform the fill }
  if Delta > 0 then begin
    for I := 0 to Colors do begin
      case Direction of
        { Calculate the color band's top and bottom coordinates }
        fdTopToBottom, fdBottomToTop: begin
          ColorBand.Top := ARect.Top + I * Delta;
          ColorBand.Bottom := ColorBand.Top + Delta;
        end;
        { Calculate the color band's left and right coordinates }
        fdLeftToRight, fdRightToLeft: begin
          ColorBand.Left := ARect.Left + I * Delta;
          ColorBand.Right := ColorBand.Left + Delta;
        end;
      end; {case}
      { Calculate the color band's color }
      Brush := CreateSolidBrush(RGB(
        StartRGB[0] + MulDiv(I, RGBDelta[0], Colors - 1),
        StartRGB[1] + MulDiv(I, RGBDelta[1], Colors - 1),
        StartRGB[2] + MulDiv(I, RGBDelta[2], Colors - 1)));
      FillRect(Canvas.Handle, ColorBand, Brush);
      DeleteObject(Brush);
    end;
  end;
  if Direction in [fdTopToBottom, fdBottomToTop] then
    Delta := HeightOf(ARect) mod Colors
  else Delta := WidthOf(ARect) mod Colors;
  if Delta > 0 then begin
    case Direction of
      { Calculate the color band's top and bottom coordinates }
      fdTopToBottom, fdBottomToTop: begin
        ColorBand.Top := ARect.Bottom - Delta;
        ColorBand.Bottom := ColorBand.Top + Delta;
      end;
      { Calculate the color band's left and right coordinates }
      fdLeftToRight, fdRightToLeft: begin
        ColorBand.Left := ARect.Right - Delta;
        ColorBand.Right := ColorBand.Left + Delta;
      end;
    end; {case}
    case Direction of
      fdTopToBottom, fdLeftToRight:
        Brush := CreateSolidBrush(EndColor);
      else {fdBottomToTop, fdRightToLeft }
        Brush := CreateSolidBrush(StartColor);
    end;
    FillRect(Canvas.Handle, ColorBand, Brush);
    DeleteObject(Brush);
  end;
end;

procedure GradientXPFillRect (ACanvas : TCanvas; ARect : TRect; LightColor : TColor; DarkColor : TColor; Colors : Byte);
const
  cLightColorOffset : Integer = 30;
  cMainBarOffset : Integer = 6;
var
  DRect : TRect;
  I : Integer;
begin
  if IsRectEmpty(ARect) then Exit;

  ACanvas.Brush.Color := DarkColor;
  ACanvas.FrameRect (ARect);
  //InflateRect (ARect, -1, -1);

  //Main center rect
  DRect := ARect;
  DRect.Left := DRect.Left + cMainBarOffset;
  DRect.Top := DRect.Top + cMainBarOffset;
  DRect.Bottom := DRect.Bottom - cMainBarOffset;
  GradientSimpleFillRect (ACanvas, DRect, DarkColor, LightColor, fdTopToBottom, Colors);

  //Bottom rect
  DRect := ARect;
  DRect.Left := DRect.Left + cMainBarOffset;
  DRect.Top := ARect.Bottom - cMainBarOffset;
  GradientSimpleFillRect (ACanvas, DRect, LightColor, DarkColor, fdTopToBottom, Colors);

  //Second left rect
  DRect := ARect;
  DRect := Rect (ARect.Left + cMainBarOffset div 4, 0, ARect.Left + cMainBarOffset, 1);
  For I := ARect.Top + cMainBarOffset to ARect.Bottom do
  begin
    DRect.Top := I;
    DRect.Bottom := I+1;
    GradientSimpleFillRect (ACanvas, DRect, ACanvas.Pixels [DRect.Left-1, DRect.Top],
      ACanvas.Pixels [DRect.Right + 1, DRect.Top], fdLeftToRight, 8);
  end;

  //Top light rect
  DRect := ARect;
  DRect.Left := DRect.Left + cMainBarOffset;
  DRect.Bottom := DRect.Top + cMainBarOffset div 4;
  GradientSimpleFillRect (ACanvas, DRect, MakeDarkColor (LightColor, -cLightColorOffset), LightColor, fdTopToBottom, 8);

  //Second top rect
  DRect := ARect;
  DRect.Left := DRect.Left + cMainBarOffset;
  DRect.Top := DRect.Top + cMainBarOffset div 4;
  DRect.Bottom := ARect.Top + cMainBarOffset;
  GradientSimpleFillRect (ACanvas, DRect, LightColor, DarkColor, fdTopToBottom, 8);

  //Left light rect
  DRect := ARect;
  DRect.Top := DRect.Top + cMainBarOffset;
  DRect.Right := DRect.Left + cMainBarOffset div 4;
  GradientSimpleFillRect (ACanvas, DRect, MakeDarkColor (LightColor, -cLightColorOffset), LightColor, fdLeftToRight, 8);

  //Second left rect
  DRect := ARect;
  DRect := Rect (ARect.Left + cMainBarOffset div 4, 0, ARect.Left + cMainBarOffset, 1);
  For I := ARect.Top + cMainBarOffset to ARect.Bottom do
  begin
    DRect.Top := I;
    DRect.Bottom := I+1;
    GradientSimpleFillRect (ACanvas, DRect, ACanvas.Pixels [DRect.Left-1, DRect.Top],
      ACanvas.Pixels [DRect.Right + 1, DRect.Top], fdLeftToRight, 8);
  end;

  For I := 0 to cMainBarOffset do
  begin
    ACanvas.Pen.Color := ACanvas.Pixels [ARect.Left + I, ARect.Top + cMainBarOffset+1];
    ACanvas.MoveTo (ARect.Left + I, ARect.Top + cMainBarOffset);
    ACanvas.LineTo (ARect.Left + I, ARect.Top + I);
    ACanvas.LineTo (ARect.Left + cMainBarOffset, ARect.Top + I);
  end;
end;


procedure GradientFillRect(Canvas: TCanvas; ARect: TRect; StartColor,