sputils.pas

一款支持Delphi和C++ Builder的VCL控件

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       DynamicSkinForm                                             }
{       Version 9.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}
                         
unit SPUtils;

{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}

interface

{$R-}

uses
  Windows, Controls, Messages, SysUtils, Classes, Graphics, IniFiles, JPeg,
  ImgList;

const
  maxi = 10000;
  //

  SP_XP_BTNFRAMECOLOR = 8388608;
  SP_XP_BTNACTIVECOLOR = 13811126;
  SP_XP_BTNDOWNCOLOR = 11899781;

  CM_SEPAINT  = CM_BASE + 456;
  CM_SENCPAINT    = CM_BASE + 457;
  SE_RESULT = $3233;
  CM_CANSTARTFORMANIMATION = CM_BASE + 434;
  SE_STOPANIMATION = $3234;
  SE_CANANIMATION = $3235;
  
type
  TspStretchType = (spstFull, spstHorz, spstVert);

{ TFBitmap }

  TFBColor  = record b,g,r:Byte end;
  PFBColor  =^TFBColor;
  TBLine    = array[0..0]of TFBColor;
  PBLine    =^TBLine;
  TPLines  = array[0..0]of PBLine;
  PPLines  =^TPLines;

  TFBitmap = class
  private
    Bits:   Pointer;
    procedure   Initialize;
  public
    Pixels: PPLines;
    Gap,
    RowInc,
    Size,   
    Width,
    Height: Integer;
    Handle,
    hDC:        Integer;
    bmInfo:     TBitmapInfo;
    bmHeader:   TBitmapInfoHeader;
    constructor Create(HBmp:Integer);
    destructor  Destroy; override;
  end;

  TspNumGlyphs = 1..4;
  TspButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);

  TRectArray = array[0..maxi] of TRect;
  

//
function EqRects(R1, R2: TRect): Boolean;
function EqPoints(const Pt1, Pt2: TPoint): Boolean;
function NullRect: TRect;
function IsNullRect(R: TRect): Boolean;
function IsNullPoint(P: TPoint): Boolean;
function RectInRect(R1, R2: TRect): Boolean;
//
function RectWidth(R: TRect): Integer;
function RectHeight(R: TRect): Integer;
function RectToCenter(var R: TRect; Bounds: TRect): TRect;
// Region functions
function CreateRgnFromBmp(B: TBitmap; XO, YO: Integer; var RgnData: PRgnData): integer;
// Stream functions
procedure WriteStringToStream(Str: String; S: TStream);
procedure ReadStringFromStream(var Str: String; S: TStream);
// Skin functions
function GetRect(S: String): TRect;
function GetPoint(S: String): TPoint;
function SetRect(R: TRect): String;


procedure CreateSkinBorderImages(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
  NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
  LeftB, TopB, RightB, BottomB, SB: TBitMap; R: TRect; AW, AH: Integer;
  LS, TS, RS, BS: Boolean);

procedure CreateSkinImageBS(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
  NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; DrawClient: Boolean;
  LS, TS, RS, BS: Boolean; AStretchEffect: Boolean; AStretchType: TspStretchType);

procedure CreateSkinBG(ClRect: TRect; NewClRect: TRect;
   B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean;
   AStretchType: TspStretchType);

procedure CreateSkinImage(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
  NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; ADrawClient: Boolean;
  ALeftStretch, ATopStretch, ARightStretch, ABottomStretch,
  AClientStretch: Boolean; AStretchType: TspStretchType);

procedure CreateSkinImage2(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
  NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; ADrawClient,
  ALeftStretch, ATopStretch, ARightStretch, ABottomStretch,
  AClientStretch: Boolean; AStretchType: TspStretchType);


procedure CreateStretchImage(B: TBitMap;  SB: TBitMap; R: TRect; ClRect: TRect;
                             ADrawClient: Boolean);

procedure CreateHSkinImage(LO, RO: Integer;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);

procedure CreateHSkinImage2(LO, RO: Integer;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);

procedure CreateHSkinImage3(LO, RO: Integer;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);

procedure CreateVSkinImage(TpO, BO: Integer;
  B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
  
procedure CreateSkinMask(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
  NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
  FMask, RMTop, RMLeft, RMRight, RMBottom: TBitMap; AW, AH: Integer);

procedure CreateSkinSimplyRegion(var FRgn: HRgn; FMask: TBitMap);

procedure CreateSkinRegion(var FRgn: HRgn;
  LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
  NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
  FMask: TBitMap; AW, AH: Integer);

procedure DrawGlyph(Cnvs: TCanvas; X, Y: Integer; FGlyph: TBitMap;
                    FNumGlyphs, FGlyphNum: Integer);

// IniFile funcitons
function ReadRect(IniFile: TCustomIniFile; Section: String; Ident: String): TRect;
function ReadPoint(IniFile: TCustomIniFile; Section: String; Ident: String): TPoint;
function ReadBoolean(IniFile: TCustomIniFile; Section: String; Ident: String): Boolean;
function ReadFontStyles(IniFile: TCustomIniFile;
                        Section: String; Ident: String): TFontStyles;
procedure ReadStrings(IniFile: TCustomIniFile;
                      Section: String; Ident: String; S: TStrings);
procedure ReadStrings1(IniFile: TCustomIniFile;
                       Section: String; Ident: String; S: TStrings);
function ReadAlignment(IniFile: TCustomIniFile;
                       Section: String; Ident: String): TAlignment;
procedure WriteAlignment(IniFile: TCustomIniFile;
                         Section: String; Ident: String; A: TAlignment);
procedure WriteRect(IniFile: TCustomIniFile; Section: String; Ident: String; R: TRect);
procedure WritePoint(IniFile: TCustomIniFile; Section: String; Ident: String; P: TPoint);
procedure WriteBoolean(IniFile: TCustomIniFile; Section: String; Ident: String; B: Boolean);
procedure WriteFontStyles(IniFile: TCustomIniFile;
                          Section: String; Ident: String; FS: TFontStyles);
procedure WriteStrings(IniFile: TCustomIniFile;
                       Section: String; Ident: String; S: TStrings);
procedure WriteStrings1(IniFile: TCustomIniFile;
                        Section: String; Ident: String; S: TStrings);

procedure GetScreenImage(X, Y: Integer; B: TBitMap);

procedure GetWindowsVersion(var Major, Minor: Integer);
function CheckW2KWXP: Boolean;

function CheckWXP: Boolean;

procedure SetAlphaBlendTransparent(WHandle: HWnd; Value: Byte);

function IsJpegFile(AFileName: String): Boolean;
procedure LoadFromJpegFile(SB: TBitMap; AFileName: String);
procedure LoadFromJpegStream(SB: TBitMap; AStream: TStream);
procedure LoadFromJPegImage(SB: TBitMap; JI: TJpegImage);

procedure Frm3D(Canvas: TCanvas; Rect: TRect; TopColor, BottomColor: TColor);
procedure DrawRadioImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawCheckImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawArrowImage(Cnvs: TCanvas; R: TRect; Color: TColor; Code: Integer);
procedure DrawTrackArrowImage(Cnvs: TCanvas; R: TRect; Color: TColor);
procedure GetParentImage(Control: TControl; Dest: TCanvas);
procedure GetParentImageRect(Control: TControl; Rct: TRect; Dest: TCanvas);
function PointInRect(R: TRect; P: TPoint): Boolean;

function CalcTextWidthW(C: TCanvas; Str: WideString): Integer;
function CalcTextHeightW(C: TCanvas; Str: WideString): Integer;
function SPDrawSkinText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag: cardinal): integer;
procedure SPDrawText(Cnvs: TCanvas; S: String; R: TRect);
procedure SPDrawText2(Cnvs: TCanvas; S: String; R: TRect);
procedure SPDrawText3(Cnvs: TCanvas; S: String; R: TRect; HorOffset: Integer);

procedure DrawCloseImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRCloseImage(C: TCanvas; R: TRect; Color: TColor);
procedure DrawMinimizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawMaximizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRollUpImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRestoreRollUpImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRestoreImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawSysMenuImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawMTImage(C: TCanvas; X, Y: Integer; Color: TColor);

function ExtractDay(ADate: TDateTime): Word;
function ExtractMonth(ADate: TDateTime): Word;
function ExtractYear(ADate: TDateTime): Word;
function IsLeapYear(AYear: Integer): Boolean;
function DaysPerMonth(AYear, AMonth: Integer): Integer;

function Max(A, B: Longint): Longint;
function Min(A, B: Longint): Longint;

procedure CorrectTextbyWidth(C: TCanvas; var S: String; W: Integer);
procedure CorrectTextbyWidthW(C: TCanvas; var S: WideString; W: Integer);

function GetMonitorWorkArea(const W: HWND; const WorkArea: Boolean): TRect;
function GetPrimaryMonitorWorkArea(const WorkArea: Boolean): TRect;
function MyGetScrollBarInfo(wnd: Cardinal; idObject: Longint; var psbi: TScrollBarInfo): BOOL;

function IsVistaOs: Boolean;
function Is9XOS: Boolean;


procedure CalcLCoord(Layout: TspButtonLayout; R: TRect; gw, gh, tw, th: Integer;
  Spacing, Margin: Integer; var tx, ty, gx, gy: Integer);

procedure DrawImageAndText(Cnvs: TCanvas; R: TRect; Margin, Spacing: Integer;
            Layout: TspButtonLayout;
            Caption: String; ImageIndex: Integer; IL: TCustomIMageList; ADown: Boolean;
            AEnabled: Boolean; ADrawColorMarker: Boolean; AColorMarkerValue: TColor);

procedure DrawGlyphAndText(Cnvs: TCanvas;
  R: TRect; Margin, Spacing: Integer; Layout: TspButtonLayout;
  Caption: String; Glyph: TBitMap; NumGlyphs, GlyphNum: Integer; ADown: Boolean;
  ADrawColorMarker: Boolean; AColorMarkerValue: TColor);
              
var
  SP_PlatformIsUnicode: Boolean;
  GetScrollBarInfoFunc: function (wnd: Cardinal; idObject: Longint; var psbi: TScrollBarInfo): BOOL; stdcall;

implementation //========================================================

uses Forms, Consts, SkinTabs;

const
  LWA_ALPHA = $2;

type
  TParentControl = class(TWinControl);

procedure CalcLCoord(Layout: TspButtonLayout; R: TRect; gw, gh, tw, th: Integer;
  Spacing, Margin: Integer; var tx, ty, gx, gy: Integer);
var
  H, W, H1, W1: Integer;
begin
 H := R.Top + RectHeight(R) div 2;
 W := R.Left + RectWidth(R) div 2;
 if Margin = -1
 then
   begin
     W1 := (tw + gw + Spacing) div 2;
     H1 := (th + gh + Spacing) div 2;
     case Layout of
       blGlyphRight:
         begin
           tx := W - W1;
           ty := H - th div 2;
           gx := W + W1 - gw;
           gy := H - gh div 2;
         end;
      blGlyphLeft:
         begin
           gx := W - W1;
           gy := H - gh div 2;
           tx := W + W1 - tw;
           ty := H - th div 2;
         end;
      blGlyphTop:
         begin
           tx := W - tw div 2;
           ty := H + H1 - th;
           gx := W - gw div 2;
           gy := H - H1;
        end;
     blGlyphBottom:
        begin
          gx := W - gw div 2;
          gy := H + H1 - gh;
          tx := W - tw div 2;
          ty := H - H1;
       end;
     end;
   end
 else
   begin
     case Layout of
       blGlyphRight:
         begin
           gy := H - gh div 2;
           gx := R.Right - gw - Margin;
           tx := gx - Spacing - tw;
           ty := H - th div 2;
         end;
       blGlyphLeft:
         begin
           gy := H - gh div 2;
           gx := R.Left + Margin;
           tx := gx + gw + Spacing;
           ty := H - th div 2;
         end;
       blGlyphTop:
          begin
            gy := R.Top +  Margin;
            gx := W - gw div 2;
            ty := gy + gh + Spacing;
            tx := W - tw div 2;
          end;
      blGlyphBottom:
          begin
            gy := R.Bottom - gh - Margin;
            gx := W - gw div 2;
            ty := gy - Spacing - th;
            tx := W - tw div 2;
         end;
       end;
    end;
end;

procedure DrawImageAndText(Cnvs: TCanvas; R: TRect; Margin, Spacing: Integer;
            Layout: TspButtonLayout;
            Caption: String; ImageIndex: Integer; IL: TCustomIMageList; ADown: Boolean;
            AEnabled: Boolean; ADrawColorMarker: Boolean; AColorMarkerValue: TColor);

var
  gw, gh: Integer;
  tw, th: Integer;
  TX, TY, GX, GY: Integer;
  TR: TRect;
begin
  if (ImageIndex < 0) or (IL = nil) or (ImageIndex >= IL.Count)
  then
    begin
      gw := 0;
      gh := 0;
    end
  else
    begin
      gw := IL.Width;
      gh := IL.Height;
    end;
  with Cnvs do
  begin
    if Caption = ''
    then
      begin
        tw := 0;
        th := 0;
      end
    else
      begin
        TR := Rect(0, 0, RectWidth(R), RectHeight(R));
        if (Layout = blGlyphLeft) or (Layout = blGlyphRight)
        then
          begin
            Dec(TR.Right, gw);
          end
        else
        if (Layout = blGlyphTop) or (Layout = blGlyphBottom)
        then
          begin
            Dec(TR.Bottom, gh);
          end;
        DrawText(Handle, PChar(Caption), Length(Caption), TR,
             DT_EXPANDTABS or DT_WORDBREAK or DT_CALCRECT);
        tw := RectWidth(TR);
        th := RectHeight(TR);
      end;
    Brush.Style := bsClear;
  end;
  CalcLCoord(Layout, R, gw, gh, tw, th, Spacing, Margin, TX, TY, GX, GY);
  if ADown
  then
    begin
      Inc(GX); Inc(GY);
      Inc(TX); Inc(TY);
    end;
  if Caption <> ''
  then
    begin
      TR := Rect(TX, TY, TX + tw, TY + th);
      Inc(TR.Right, 2);
      DrawText(Cnvs.Handle, PChar(Caption), Length(Caption), TR, DT_EXPANDTABS or DT_VCENTER or DT_CENTER or DT_WORDBREAK);
    end;
  if gw <> 0
  then
    begin
      IL.Draw(Cnvs, GX, GY, ImageIndex, AEnabled);
      if ADrawColorMarker
      then
        with Cnvs do
        begin
          Pen.Color := AColorMarkerValue;
          MoveTo(GX, GY + IL.Height - 2);
          LineTo(GX + IL.Width, GY + IL.Height - 2);
          MoveTo(GX, GY + IL.Height - 1);
          LineTo(GX + IL.Width, GY + IL.Height - 1);
          MoveTo(GX, GY + IL.Height);
          LineTo(GX + IL.Width, GY + IL.Height);
        end;
    end
  else
    if ADrawColorMarker
    then
      with Cnvs do
      begin
        if Caption <> ''
        then
          begin
            Pen.Color := AColorMarkerValue;
            MoveTo(TR.Left, TR.Bottom  - 1);
            LineTo(TR.Right, TR.Bottom  - 1);
            MoveTo(TR.Left, TR.Bottom );
            LineTo(TR.Right, TR.Bottom);
            MoveTo(TR.Left, TR.Bottom  + 1);
            LineTo(TR.Right, TR.Bottom  + 1);
          end
        else