sxskinutils.pas

skin components for design of your applicastions

unit SXSkinUtils;

////////////////////////////////////////////////////////////////////////////////
// SXSkinComponents: Skinnable Visual Controls for Delphi and C++Builder      //
//----------------------------------------------------------------------------//
// Version: 1.2.1                                                             //
// Author: Alexey Sadovnikov                                                  //
// Web Site: http://www.saarixx.info/sxskincomponents/                        //
// E-Mail: [e-mail]                                      //
//----------------------------------------------------------------------------//
// LICENSE:                                                                   //
// 1. You may freely distribute this file.                                    //
// 2. You may not make any changes to this file.                              //
// 3. The only person who may change this file is Alexey Sadovnikov.          //
// 4. You may use this file in your freeware projects.                        //
// 5. If you want to use this file in your shareware or commercial project,   //
//    you should purchase a project license or a personal license of          //
//    SXSkinComponents: http://saarixx.info/sxskincomponents/en/purchase.htm  //
// 6. You may freely use, distribute and modify skins for SXSkinComponents.   //
// 7. You may create skins for SXSkinComponents.                              //
//----------------------------------------------------------------------------//
// Copyright (C) 2006-2007, Alexey Sadovnikov. All Rights Reserved.           //
////////////////////////////////////////////////////////////////////////////////

interface

{$I Compilers.inc}

uses Windows, Classes, Controls;

function WithoutAllSpaces(const S:String):String;
function GetFilePath(const S:String):String;
function IsRoot(S:String):Boolean;
function GetServerRoot(S:String):String;
function GetUpDir(S:String):String;
function GetFullPath(const Relative,Current:String):String;
function WithoutLastSlash(const S:String):String;
function WithLastSlash(const S:String):String;
function SXStrToFloatDef(S:String;Default:Real):Real;
procedure SXLStrCmp(const S1,S2:AnsiString);
function ValueFromIndex(SL:TStrings;Index:Integer):String;
procedure SetValueFromIndex(SL:TStrings;Index:Integer;const NewValue:String);
function PathIsRelative(const S:String):Boolean;
function GetRelativePath(Main,Changeable:String):String;
procedure SetComponentEnabled(A:TWinControl;C:Boolean);

procedure Save8Flags(Stream:TStream;F1,F2,F3,F4,F5,F6,F7,F8:Boolean);
procedure Load8Flags(Stream:TStream;out F1,F2,F3,F4,F5,F6,F7,F8:Boolean);
procedure Load8MaskedFlags(Stream:TStream;out F1,F2,F3,F4,F5,F6,F7,F8:Boolean;
           MF1,MF2,MF3,MF4,MF5,MF6,MF7,MF8:Boolean);
procedure SaveString(Stream:TStream;const S:String);
procedure LoadString(Stream:TStream;out S:String);
procedure SavePackedInteger(S:TStream;A:Integer);
procedure LoadPackedInteger(S:TStream;out A:Integer);
procedure SaveListToStream(Stream:TStream;T:TStringList);
procedure LoadListFromStream(Stream:TStream;T:TStringList);

function PtInRoundRect(PX,PY,X1,Y1,X2,Y2,R:Single):Boolean; overload;
function PtInRoundRect(PX,PY,X1,Y1,X2,Y2,R:Integer):Boolean; overload;
function PtInEllipse(PX,PY,X1,Y1,X2,Y2:Single):Boolean; overload;
function PtInEllipse(PX,PY,X1,Y1,X2,Y2:Integer):Boolean; overload;

procedure NormalizeWinPoint(var P:TPoint);

implementation

uses SysUtils, Math;

function WithoutAllSpaces(const S:String):String;
var A,B:Integer;
begin
 if S='' then
  begin
   Result:='';
   exit;
  end;
 SetLength(Result,length(S));
 A:=1; B:=0;
 while A<=length(S) do
  begin
   if not (S[A] in [' ',#10,#13,#9]) then
    begin
     Inc(B);
     Result[B]:=S[A];
    end;
   Inc(A);
  end;
 SetLength(Result,B);
end;

function GetFilePath(const S:String):String;
var A,B:Integer;
begin
 B:=0;
 for A:=1 to length(S) do
  begin
   if S[A]='?' then break;
   if (S[A]='/') or (S[A]='\') then B:=A;
  end;
 if B=0 then Result:='' else
  Result:=Copy(S,1,B);
end;

function GetServerRoot(S:String):String;
var A:Integer;
begin
 A:=Pos(':\',S);
 if A>0 then
  begin
   Result:=Copy(S,1,A+1);
   Delete(S,1,A+1);
  end else
   begin
    A:=Pos('://',S);
    if A>0 then
     begin
      Result:=Copy(S,1,A+2);
      Delete(S,1,A+2);
     end;
   end;
 while (S<>'') and (S[1]<>'/') and (S[1]<>'\') do
  begin
   Result:=Result+S[1];
   Delete(S,1,1);
  end;
end;

function IsRoot(S:String):Boolean;
var A:Integer;
begin
 A:=Pos(':\',S);
 if A>0 then Delete(S,1,A+1) else
  begin
   A:=Pos('://',S);
   if A>0 then Delete(S,1,A+2);
  end;
 Result:=(Pos('/',S)=0) and (Pos('\',S)=0);
end;

function GetUpDir(S:String):String;
begin
 S:=WithoutLastSlash(S);
 if IsRoot(S) then
  begin
   Result:=S;
   exit;
  end;
 while (S<>'') and (S[length(S)]<>'/') and (S[length(S)]<>'\') do
  Delete(S,length(S),1);
 S:=WithoutLastSlash(S);
 if S='' then S:='/';
 Result:=S;
end;

function GetFullPath(const Relative,Current:String):String; {Relative File Name; Full File Name}
var S1,S2,SS:String;
           A:Integer;
begin
 S1:=Current;
 S2:=Relative;
 A:=Pos('?',S2);
 if A>0 then
  begin
   SS:=Copy(S2,A,MaxInt);
   Delete(S2,A,MaxInt);
  end else SS:='';
 try
  if S2='' then S2:='/';
  if (Pos('//',S2)<>0) or
     (Pos('\\',S2)<>0) or
     (Pos(':\',S2)<>0) then
      begin
       Result:=S2;
       exit;
      end;
  S1:=GetFilePath(S1);
  if (S2[1]='/') or (S2[1]='\') or (Copy(S2,1,2)='./') or (Copy(S2,1,2)='.\') then
   begin
    if S2[1]='.' then Delete(S2,1,1);
    S1:=GetServerRoot(S1);
    Result:=S1+S2;
   end else
    begin
     while (Pos('../',S2)=1) or (Pos('..\',S2)=1) do
      begin
       S1:=GetUpDir(S1);
       Delete(S2,1,3);
      end;
     Result:=WithLastSlash(S1)+S2;
    end;
 finally
  Result:=Result+SS
 end;
end;

function WithoutLastSlash(const S:String):String;
begin
 Result:=S;
 if (Result<>'') and (Result[length(Result)] in ['/','\']) then
  Delete(Result,length(S),1);
end;

function WithLastSlash(const S:String):String;
begin
 if S='' then
  begin
   Result:='/';
   exit;
  end;
 Result:=S;
 if (Result[length(Result)]<>'/') and (Result[length(Result)]<>'\') then
  begin
   if Pos('\',S)<>0 then Result:=Result+'\' else
    Result:=Result+'/';
  end;
end;

function SXStrToFloatDef(S:String;Default:Real):Real;
var A:Integer;
begin
 A:=Pos(',',S);
 if A<>0 then S[A]:='.';
 {$R-}Val(S,Result,A);{$R+}
 if A<>0 then
  Result:=Default;
end;

procedure SXLStrCmp(const S1,S2:AnsiString);
type
  PStrRec = ^StrRec;
  StrRec = packed record
    refCnt: Longint;
    length: Longint;
  end;
const
  skew = SizeOf(StrRec);
asm
        PUSH    EBX
        PUSH    ESI
        PUSH    EDI
        MOV     ESI,EAX
        MOV     EDI,EDX
        CMP     EAX,EDX
        JE      @@exit
        TEST    ESI,ESI
        JE      @@str1null
        TEST    EDI,EDI
        JE      @@str2null
        MOV     EAX,[ESI-skew].StrRec.length
        MOV     EDX,[EDI-skew].StrRec.length
        SUB     EAX,EDX { eax = len1 - len2 }
        JA      @@skip1
        ADD     EDX,EAX { edx = len2 + (len1 - len2) = len1     }
@@skip1:
        PUSH    EDX
        SHR     EDX,2
        JE      @@cmpRest
@@longLoop:
        MOV     ECX,[ESI]
        MOV     EBX,[EDI]
        CMP     ECX,EBX
        JNE     @@misMatch
        DEC     EDX
        JE      @@cmpRestP4
        MOV     ECX,[ESI+4]
        MOV     EBX,[EDI+4]
        CMP     ECX,EBX
        JNE     @@misMatch
        ADD     ESI,8
        ADD     EDI,8
        DEC     EDX
        JNE     @@longLoop
        JMP     @@cmpRest
@@cmpRestP4:
        ADD     ESI,4
        ADD     EDI,4
@@cmpRest:
        POP     EDX
        AND     EDX,3
        JE      @@equal
        MOV     ECX,[ESI]
        MOV     EBX,[EDI]
        CMP     CL,BL
        JNE     @@exit
        DEC     EDX
        JE      @@equal
        CMP     CH,BH
        JNE     @@exit
        DEC     EDX
        JE      @@equal
        AND     EBX,$00FF0000
        AND     ECX,$00FF0000
        CMP     ECX,EBX
        JNE     @@exit
@@equal:
        ADD     EAX,EAX
        JMP     @@exit
@@str1null:
        MOV     EDX,[EDI-skew].StrRec.length
        SUB     EAX,EDX
        JMP     @@exit
@@str2null:
        MOV     EAX,[ESI-skew].StrRec.length
        SUB     EAX,EDX
        JMP     @@exit
@@misMatch:
        POP     EDX
        CMP     CL,BL
        JNE     @@exit
        CMP     CH,BH
        JNE     @@exit
        SHR     ECX,16
        SHR     EBX,16
        CMP     CL,BL
        JNE     @@exit
        CMP     CH,BH

@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
end;

function ValueFromIndex(SL:TStrings;Index:Integer):String;
{$IFNDEF COMPILER_9_UP}
var A:Integer;
{$ENDIF}
begin
 {$IFNDEF COMPILER_9_UP}
 Result:='';
 if (Index<0) or (Index>=SL.Count) then exit;
 A:=Pos('=',SL[Index]);
 if A=0 then exit;
 Result:=Copy(SL[Index],A+1,MaxInt);
 {$ELSE}
 Result:=SL.ValueFromIndex[Index];
 {$ENDIF}
end;

procedure SetValueFromIndex(SL:TStrings;Index:Integer;const NewValue:String);
{$IFNDEF COMPILER_9_UP}
var A:Integer;
{$ENDIF}
begin
 {$IFNDEF COMPILER_9_UP}
 if (Index<0) or (Index>=SL.Count) then exit;
 A:=Pos('=',SL[Index]);
 if A=0 then
  begin
   SL[Index]:=SL[Index]+'='+NewValue;
   exit;
  end;
 SL[Index]:=Copy(SL[Index],1,A)+NewValue;
 {$ELSE}
 SL.ValueFromIndex[Index]:=NewValue;
 {$ENDIF}
end;

function PathIsRelative(const S:String):Boolean;
begin
 Result:=True;
 if (Pos(':\',S)<>0) or (Pos(':/',S)<>0) then
  Result:=False;
end;