converterunit.pas

skin components for design of your applicastions

function ConvertRect(S:String):TRect;
var A:Integer;
begin
 S:=StringReplace(S,' ','',[rfReplaceAll]);
 A:=Pos(',',S);
 Result.Left:=StrToIntDef(Copy(S,1,A-1),0);
 Delete(S,1,A);
 A:=Pos(',',S);
 Result.Right:=StrToIntDef(Copy(S,1,A-1),0);
 Delete(S,1,A);
 A:=Pos(',',S);
 Result.Top:=StrToIntDef(Copy(S,1,A-1),0);
 Result.Bottom:=StrToIntDef(Copy(S,A+1,MaxInt),0);
end;

function ConvertPoint(S:String):TPoint;
var A:Integer;
begin
 S:=StringReplace(S,' ','',[rfReplaceAll]);
 A:=Pos(',',S);
 Result.X:=StrToIntDef(Copy(S,1,A-1),0);
 Result.Y:=StrToIntDef(Copy(S,A+1,MaxInt),0);
end;

procedure ConvertFont(S:String;var FontName:String;var FontSize:Integer;var FontStyle:TFontStyles);
var A:Integer;
begin
 FontSize:=10;
 FontStyle:=[];
 A:=Pos(',',S);
 if A<=0 then
  begin
   FontName:=Trim(S);
   exit;
  end;
 FontName:=Trim(Copy(S,1,A-1));
 Delete(S,1,A);
 S:=Trim(S);
 A:=Pos(',',S);
 if A>0 then
  begin
   FontSize:=StrToIntDef(Trim(Copy(S,1,A-1)),10);
   Delete(S,1,A);
   S:=LowerCase(Trim(S));
   if Pos('bold',S)>0 then
    Include(FontStyle,fsBold);
   if Pos('italic',S)>0 then
    Include(FontStyle,fsItalic);
   if Pos('underline',S)>0 then
    Include(FontStyle,fsUnderline);
  end else FontSize:=StrToIntDef(S,10);
end;

function ConvertFontStyle(FS:TFontStyles):String;
begin
 Result:='';
 if fsBold in FS then Result:=Result+'b';
 if fsItalic in FS then Result:=Result+'i';
 if fsUnderline in FS then Result:=Result+'u';
end;

function CorrectFont(const S:String):String;
const GF:array[1..29]of String = ('Arial',
                                  'Arial Black',
                                  'Arial Narrow',
                                  'Book Antiqua',
                                  'Bookman Old Style',
                                  'Century Gothic',
                                  'Comic Sans MS',
                                  'Courier',
                                  'Courier New',
                                  'Franklin Gothic Book',
                                  'Franklin Gothic Medium',
                                  'Garamond',
                                  'Gautami',
                                  'Georgia',
                                  'Lucida Console',
                                  'Lucida Sans',
                                  'Microsoft Sans Serif',
                                  'MS Sans Serif',
                                  'Monotype Corsiva',
                                  'Symbol',
                                  'Small Fonts',
                                  'Tahoma',
                                  'Times New Roman',
                                  'Trebuchet MS',
                                  'Verdana',
                                  'Webdings',
                                  'WingDings',
                                  'Wingdings 2',
                                  'Wingdings 3');
var A:Integer;
begin
 for A:=Low(GF) to High(GF) do
  if SameText(S,GF[A]) then
   begin
    Result:=S;
    exit;
   end;
 Result:='Tahoma';
end;

function CorrectAlignment(S:String):String;
begin
 S:=LowerCase(Trim(S));
 if S='center' then Result:='Center' else
  if S='right' then Result:='Right' else
   Result:='Left';
end;

function TForm1.ShortPath(const FullPath,MyName:String):String;
begin
 Result:=Copy(FullPath,length(DirPath+MyName)+2,MaxInt);
end;

function TForm1.FullPath(const ShortPath,MyName:String):String;
begin
 Result:=DirPath+MyName+'\'+ShortPath;
end;

function TForm1.SavedShort(const ShortPath,MyName:String):String;
begin
 Result:=FullPath(ShortPath,MyName);
 Result:=SavedBitmaps.GetSavedBitmapPath(Result);
 Result:=Self.ShortPath(Result,MyName);
end;

function TForm1.BoxTileShort(const ShortPath,Name,MyName:String):String;
var S:String;
    A:Integer;
  Fnd:Boolean;
begin
 S:=StringReplace(ShortPath,Name,'*',[rfReplaceAll]);
 Fnd:=False;
 for A:=length(S) downto 1 do
  if S[A]='*' then
   begin
    if not Fnd then Fnd:=True else
     S:=Copy(S,1,A-1)+Name+Copy(S,A+1,MaxInt);
   end;
 Result:=S;  
end;

procedure TForm1.SaveRedirectedBoxTile(const Section,EIndex,ShortPath,MyName:String;SkinIni:TIniFile);
const Names:array[1..9]of String=('TopLeft','Top','TopRight',
                                  'Left','Center','Right',
                                  'BottomLeft','Bottom','BottomRight');
var RedirShort:array[1..9]of String;
    RedirColor:array[1..9]of String;
    RedirCount:array[1..9]of Integer;
      A,B,MaxI:Integer;
begin
 for A:=1 to 9 do
  begin
   RedirShort[A]:=BoxTileShort(SavedShort(StringReplace(ShortPath,'*',LowerCase(Names[A]),[]),MyName),LowerCase(Names[A]),MyName);
   RedirColor[A]:=SavedBitmaps.GetSavedBitmapColor(FullPath(StringReplace(ShortPath,'*',LowerCase(Names[A]),[]),MyName));
  end;
 for A:=1 to 9 do
  RedirCount[A]:=0;
 for A:=1 to 9 do
  if RedirColor[A]='' then
   begin
    for B:=1 to 9 do
     if (RedirColor[B]='') and (RedirShort[B]=RedirShort[A]) then
      Inc(RedirCount[A]);
   end;
 MaxI:=1;
 for A:=2 to 9 do
  if (RedirShort[MaxI]='') or ((RedirShort[A]<>'') and (RedirCount[A]>RedirCount[MaxI])) then
   MaxI:=A;
 SkinIni.WriteString(Section,'E'+EIndex+'.Paths',RedirShort[MaxI]);
 for A:=1 to 9 do
  if RedirColor[A]<>'' then
   SkinIni.WriteString(Section,'E'+EIndex+'.'+Names[A],ConvertColor(RedirColor[A])) else
  if (RedirShort[A]<>'') and (RedirShort[A]<>RedirShort[MaxI]) then
   SkinIni.WriteString(Section,'E'+EIndex+'.'+Names[A],StringReplace(RedirShort[A],'*',LowerCase(Names[A]),[]));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
  Edit1.Text:=OpenDialog1.FileName;
end;

function BitmapIsOpaque(Bitmap:TBitmap):Boolean;
type PDWORDArray=array of DWORD;
var X,Y:Integer;
begin
 if Bitmap.PixelFormat=pf32bit then
  begin
   for X:=0 to Bitmap.Width-1 do
    for Y:=0 to Bitmap.Height-1 do
     if PDWORDArray(Bitmap.Scanline[Y])[X] shr 24<>255 then
      begin
       Result:=False;
       exit;
      end;
  end;
 for X:=0 to Bitmap.Width-1 do
  for Y:=0 to Bitmap.Height-1 do
   if Bitmap.Canvas.Pixels[X,Y]=clFuchsia then
    begin
     Result:=False;
     exit;
    end;
 Result:=True;
end;

function TForm1.LoadBitmap(Name:String):TBitmap;
type PDWORDArray=array of DWORD;
var A:Integer;
  X,Y:Integer;
  IsT:Boolean;
begin
 Name:=UpperCase(Name);
 for A:=1 to length(Name) do
  if Name[A] in ['.','\','/'] then
   Name[A]:='_';
 Result:=TBitmap.Create;
 try
  Result.LoadFromResourceName(Module,Name);
  if Result.PixelFormat<>pf32bit then
   Result.PixelFormat:=pf24bit else
    begin
     IsT:=True;
     for X:=0 to Result.Width-1 do
      for Y:=0 to Result.Height-1 do
       if PDWORDArray(Result.Scanline[Y])[X] shr 24<>0 then
        begin
         IsT:=False;
         break;
        end;
     if IsT then
      Result.PixelFormat:=pf24bit;
    end;
 except
  Result.Free;
  Result:=nil;
 end;
end;

function IniProp(IniFile:TIniFile;const Sections:array of String;const Name,DefValue:String):String;
const NoValue='~~~';
var A:Integer;
begin
 Result:=NoValue;
 for A:=Low(Sections) to High(Sections) do
  if Sections[A]<>'' then
   begin
    Result:=IniFile.ReadString(Sections[A],Name,NoValue);
    if Result<>NoValue then exit;
   end;
 Result:=DefValue;
end;

function IniClassProp(IniFile:TIniFile;const Section,Name,DefValue:String):String;
var S:array of String;
    A:Integer;
begin
 SetLength(S,1);
 S[0]:=Section;
 for A:=length(Section) downto 1 do
  if (Section[A]='.') or (Section[A]='(') then
   begin
    SetLength(S,High(S)+2);
    S[High(S)]:=Copy(Section,1,A-1);
   end;
 Result:=IniProp(IniFile,S,Name,DefValue);  
end;

function GetSubBitmap(Bitmap:TBitmap;const Layout:String;Count,Index:Integer):TBitmap;
var ARect:TRect;
      W,H:Integer;
begin
 W:=Bitmap.Width;
 H:=Bitmap.Height;
 if SameText(Layout,'vertical') then
  H:=H div Count else
   W:=W div Count;
 Result:=TBitmap.Create;
 Result.PixelFormat:=Bitmap.PixelFormat;
 Result.Width:=W;
 Result.Height:=H;
 ARect:=Rect(0,0,W,H);
 if SameText(Layout,'vertical') then
  OffsetRect(ARect,0,Index*H) else
   OffsetRect(ARect,Index*W,0);
 Result.Canvas.Draw(-ARect.Left,-ARect.Top,Bitmap);
end;

function RR(C:Cardinal):Cardinal;
begin
 Result:= (C and $00FF00) or
         ((C and $FF0000) shr 16) or
         ((C and $0000FF) shl 16);
end;

procedure SaveBitmapRect(Bitmap:TBitmap;ARect:TRect;const FileName:String;
           IsTransp:Boolean;TranspColor:TColor;CanRedirect:Boolean=True);
type PDWORDArray=array of DWORD;
var   T:TPNGObject;
     BB:TBitmap;
    X,Y:Integer;
    PB2:PByte;
 Opaque:Boolean;
      B:Boolean;
begin
 T:=TPNGObject.Create;
 try
  BB:=TBitmap.Create;
  try
   BB.PixelFormat:=Bitmap.PixelFormat;
   BB.Width:=ARect.Right-ARect.Left;
   BB.Height:=ARect.Bottom-ARect.Top;
   BB.Canvas.Draw(-ARect.Left,-ARect.Top,Bitmap);
   if not SavedBitmaps.FastSaveBitmap(BB,FileName,CanRedirect) then
    begin
     Opaque:=BitmapIsOpaque(BB);
     T.Assign(BB);
     if not Opaque then
      begin
       T.CreateAlpha;
       FillChar(T.AlphaScanline[0]^,BB.Width*BB.Height,0);
       for Y:=ARect.Top to ARect.Bottom-1 do
        begin
         PB2:=Pointer(T.AlphaScanline[Y-ARect.Top]);
         for X:=ARect.Left to ARect.Right-1 do
          begin
           if Bitmap.PixelFormat=pf32bit then
            begin
             PB2^:=PDWORDArray(Bitmap.Scanline[Y])[X] shr 24;
            end else
             begin
              if Bitmap.Canvas.Pixels[X,Y]=clFuchsia then
               PB2^:=0 else PB2^:=255;
             end;
           Inc(PB2);
          end;
        end;
      end else
     if IsTransp then
      begin
       B:=False;
       for Y:=ARect.Top to ARect.Bottom-1 do
        begin
         for X:=ARect.Left to ARect.Right-1 do
          if Bitmap.Canvas.Pixels[X,Y]=TranspColor then
           begin