converterunit.pas

skin components for design of your applicastions

unit ConverterUnit;

interface

{$DEFINE _DEBUGNAMES}
{$DEFINE FIXMSSTYLESBUGS}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IniFiles, SXPNGUtils, SXSkinLibrary, SXZipUtils,
  SXSkinUtils;

const
{$IFDEF DEBUGNAMES}
  _button           = 'button';
  _groupbox         = 'groupbox';
  _checkbox         = 'checkbox';
  _radiobutton      = 'radiobutton';
  _edit             = 'edit';
  _form             = 'form';
  _formbuttons      = 'formbuttons';
  _leftframe        = 'leftframe';
  _rightframe       = 'rightframe';
  _bottomframe      = 'bottomframe';
  _caption          = 'caption';
  _resize           = 'resize';
  _smallresize      = 'smallresize';
  _other            = 'other';
  _dropdown         = 'dropdown';
  _smallcaption     = 'smallcaption';
  _smallleftframe   = 'smallleftframe';
  _smallrightframe  = 'smallrightframe';
  _smallbottomframe = 'smallbottomframe';
  _minimize         = 'minimize';
  _maximize         = 'maximize';
  _restore          = 'restore';
  _close            = 'close';
  _help             = 'help';
  _smallclose       = 'smallclose';
  _glyph            = 'glyph';
  _updown           = 'updown';
  _upbutton         = 'upbutton';
  _downbutton       = 'downbutton';
  _leftbutton       = 'leftbutton';
  _rightbutton      = 'rightbutton';
{$ELSE}
  _button           = 'b';
  _groupbox         = 'g';
  _checkbox         = 'cb';
  _radiobutton      = 'rb';
  _edit             = 'e';
  _form             = 'f';
  _formbuttons      = 'fb';
  _leftframe        = 'lf';
  _rightframe       = 'rf';
  _bottomframe      = 'bf';
  _caption          = 'c';
  _resize           = 'rs';
  _smallresize      = 'sr';
  _other            = 'o';
  _dropdown         = 'dd';
  _smallcaption     = 'sc';
  _smallleftframe   = 'slf';
  _smallrightframe  = 'srf';
  _smallbottomframe = 'sbf';
  _minimize         = 'm';
  _maximize         = 'x';
  _restore          = 'r';
  _close            = 'c';
  _help             = 'h';
  _smallclose       = 'sc';
  _glyph            = 'g';
  _updown           = 'ud';
  _upbutton         = 'udu';
  _downbutton       = 'udd';
  _leftbutton       = 'udl';
  _rightbutton      = 'udr';
{$ENDIF}

type

  TSXSavedBitmap=class
   public
    Bitmap:TBitmap;
    Color:String;
    Path:String;
    RedirectPath:String;
    destructor Destroy; override;
  end;

  TSXSavedBitmapList=class
   protected
    FItem:TList;
    function Get(Index:Integer):TSXSavedBitmap;
    procedure Put(Index:Integer;Item:TSXSavedBitmap);
    function GetCount:Integer;
   public
    function GetIndexByPath(const Path:String):Integer;
    procedure Add(SXSavedBitmap:TSXSavedBitmap);
    function FastSaveBitmap(Bitmap:TBitmap;const Path:String;CanRedirect:Boolean):Boolean;
    function GetSavedBitmapPath(const Path:String):String;
    function GetSavedBitmapColor(const Path:String):String;
    procedure Delete(Index:Integer);
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
    property Item[Index:Integer]:TSXSavedBitmap read Get write Put; default;
    property Count:Integer read GetCount;
  end;

  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox5: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DirPath:String;
    Module:HModule;
    function LoadBitmap(Name:String):TBitmap;
    procedure ProcessFile(const FileName:String);
    procedure ProcessSkinScheme(const Name,FileName:String);
    procedure ProcessGeneral(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessLabel(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessButton(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessCheckBox(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessRadioButton(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessGroupBox(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessEdit(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessForm(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessFormSmallCaption(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessFormButtons(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessUpDown(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure ProcessSpinEdit(const MyName:String;SkinIni,TmpIni:TIniFile);
    procedure SaveFormCaptionButton(const APathPrefix,ButtonName,Section,MyName:String;
               SkinIni,TmpIni:TIniFile;var ButtonWidth,ButtonHeight:Integer);
    procedure SaveFormCaptionButtonGlyphs(const APathPrefix,FName,Layout:String;
               Count:Integer;SkinIni,TmpIni:TIniFile;var ImageWidth:Integer;
               GTransp:Boolean;TranspColor:TColor);
    procedure ProcessFormSmallCaptionButtons(const MyName:String;SkinIni,TmpIni:TIniFile);
    function ShortPath(const FullPath,MyName:String):String;
    function FullPath(const ShortPath,MyName:String):String;
    function SavedShort(const ShortPath,MyName:String):String;
    function BoxTileShort(const ShortPath,Name,MyName:String):String;
    procedure SaveRedirectedBoxTile(const Section,EIndex,ShortPath,MyName:String;SkinIni:TIniFile);
  end;

var
  Form1: TForm1;
  SavedBitmaps:TSXSavedBitmapList;

implementation

{$R *.dfm}

{ TSXSavedBitmap }

destructor TSXSavedBitmap.Destroy;
begin
 Bitmap.Free;
 inherited;
end;

{ TSXSavedBitmapList }

function TSXSavedBitmapList.Get(Index:Integer):TSXSavedBitmap;
begin
 Result:=TSXSavedBitmap(FItem[Index]);
end;

procedure TSXSavedBitmapList.Put(Index:Integer;Item:TSXSavedBitmap);
begin
 FItem[Index]:=Item;
end;

function TSXSavedBitmapList.GetCount:Integer;
begin
 Result:=FItem.Count;
end;

function TSXSavedBitmapList.GetIndexByPath(const Path:String):Integer;
var A:Integer;
begin
 for A:=0 to Count-1 do
  if Item[A].Path=Path then
   begin
    Result:=A;
    exit;
   end;
 Result:=-1;  
end;

procedure TSXSavedBitmapList.Add(SXSavedBitmap:TSXSavedBitmap);
begin
 FItem.Add(SXSavedBitmap);
end;

procedure TSXSavedBitmapList.Delete(Index:Integer);
begin
 Item[Index].Free;
 FItem.Delete(Index);
end;

function SameBitmaps(B1,B2:TBitmap):Boolean;
var   Y:Integer;
   Size:Integer;
  P1,P2:Pointer;
begin
 if (B1=nil) or (B2=nil) or (B1.PixelFormat<>B2.PixelFormat) then
  begin
   Result:=False;
   exit;
  end;
 Result:=(B1.Width=B2.Width) and (B1.Height=B2.Height);
 if not Result then exit;
 Size:=1;
 case B1.PixelFormat of
  pf1bit:  Size:=B1.Width div 8;
  pf4bit:  Size:=B1.Width div 2;
  pf8bit:  Size:=B1.Width;
  pf15bit: Size:=B1.Width*2;
  pf16bit: Size:=B1.Width*2;
  pf24bit: Size:=B1.Width*3;
  pf32bit: Size:=B1.Width*4;
 end;
 for Y:=0 to B1.Height-1 do
  begin
   P1:=B1.ScanLine[Y];
   P2:=B2.ScanLine[Y];
   Result:=CompareMem(P1,P2,Size);
   if not Result then exit;
  end;
{ for X:=0 to B1.Width-1 do
  for Y:=0 to B1.Height-1 do
   if B1.Canvas.Pixels[X,Y]<>B2.Canvas.Pixels[X,Y] then
    begin
     Result:=False;
     exit;
    end;}
end;

function TSXSavedBitmapList.FastSaveBitmap(Bitmap:TBitmap;const Path:String;CanRedirect:Boolean):Boolean;
var A:Integer;
   SB:TSXSavedBitmap;
begin
 SB:=TSXSavedBitmap.Create;
 SB.Path:=Path;
 if CanRedirect then
  begin
   for A:=0 to Count-1 do
    if (Item[A].RedirectPath='') and (Item[A].Color='') and SameBitmaps(Bitmap,Item[A].Bitmap) then
     begin
      SB.RedirectPath:=Item[A].Path;
      Add(SB);
      Result:=True;
      exit;
     end;
  end;
 SB.Bitmap:=TBitmap.Create;
 SB.Bitmap.Assign(Bitmap);
 Add(SB); 
 Result:=False;
end;

function TSXSavedBitmapList.GetSavedBitmapPath(const Path:String):String;
var A:Integer;
begin
 A:=GetIndexByPath(Path);
 if A<0 then
  begin
   Result:='';
   exit;
  end;
 if Item[A].RedirectPath='' then Result:=Path else
  Result:=Item[A].RedirectPath;
end;

function TSXSavedBitmapList.GetSavedBitmapColor(const Path:String):String;
var A:Integer;
begin
 A:=GetIndexByPath(Path);
 if A<0 then
  begin
   Result:='';
   exit;
  end;
 Result:=Item[A].Color;
end;

procedure TSXSavedBitmapList.Clear;
var A:Integer;
begin
 for A:=0 to Count-1 do
  Item[A].Free;
 FItem.Clear;
end;

constructor TSXSavedBitmapList.Create;
begin
 inherited Create;
 FItem:=TList.Create;
end;

destructor TSXSavedBitmapList.Destroy;
begin
 Clear;
 FItem.Free;
 inherited Destroy;
end;

/////////////////////////////////////////////////////////////////////////

function ConvertColor(S:String):String;
var A,R,G,B:Integer;
begin
 A:=Pos(' ',S);
 R:=StrToIntDef(Copy(S,1,A-1),0);
 Delete(S,1,A);
 A:=Pos(' ',S);
 G:=StrToIntDef(Copy(S,1,A-1),0);
 B:=StrToIntDef(Copy(S,A+1,MaxInt),0);
 Result:='#'+IntToHex(R,2)+IntToHex(G,2)+IntToHex(B,2);
end;

function GetTColor(S:String):TColor;
var A,R,G,B:Integer;
begin
 A:=Pos(' ',S);
 R:=StrToIntDef(Copy(S,1,A-1),0);
 Delete(S,1,A);
 A:=Pos(' ',S);
 G:=StrToIntDef(Copy(S,1,A-1),0);
 B:=StrToIntDef(Copy(S,A+1,MaxInt),0);
 Result:=R or (G shl 8) or (B shl 16);
end;