unit resourceskins; interface uses Windows,sysutils,jpeg,classes,Graphics,global; const alphaamount = 0.6; type TThemeSubset = array of ttheme; type TResource = record bmp : tbitmap; name : string; end; type TResourceCache = array of TResource; function LoadSkinResource(name : string;skinname : string;blendcolor : tcolor;IsJPEG : boolean) : tbitmap; function ReplaceSkinResource(name : string;skinname : string;blendcolor : tcolor;IsJPEG : boolean) : tbitmap; function InitSkin(dllname : string) : cardinal; procedure freeskinresources; procedure LoadSkinResourceNoCache(name : string;skinname : string;blendcolor : tcolor;IsJPEG : boolean;obmp : Tbitmap); procedure addcolortobitmap(var source : tbitmap;blendcolor : tcolor;alpha : real); Procedure loadtheme(fn : string;var theme : TThemeSubset;var name : String); implementation var DLLInstance : Cardinal = 0; ResourceCache : TResourceCache; function InitSkin(dllname : string) : cardinal; var fn : string; begin fn:=dllname+'.SKN'; DLLInstance:=0; DLLInstance:=LoadLibrary(pansichar(fn)); result:=DLLInstance; if result=0 then result:=hinstance; end; procedure addcolortobitmap(var source : tbitmap;blendcolor : tcolor;alpha : real); var x,y : integer; rin,rout : pbytearray; outval : integer; br,bg,bb : integer; function rangecheck(inp : integer) : byte; begin if inp>255 then outval:=255; if inp<0 then outval:=1; result:=byte(inp); end; begin source.pixelformat:=pf24bit; bb:=getrvalue(ColorToRGB(blendcolor)); bg:=getgvalue(ColorToRGB(blendcolor)); br:=getbvalue(ColorToRGB(blendcolor)); with source do begin for y:=0 to source.height -1 do begin rin:=scanline[y]; rout:=source.scanline[y]; x:=0; // application.processmessages; while x< 3*width-1 do begin // application.processmessages; outval:=round((alpha*(rin[x]-br))+br); rout[x]:=rangecheck(outval); // application.processmessages; outval:=round((alpha*(rin[x+1]-bg))+bg); rout[x+1]:=rangecheck(outval); // application.processmessages; outval:=round((alpha*(rin[x+2]-bb))+bb); rout[x+2]:=rangecheck(outval); x:=x+3; end; end; end; end; function getimagefromcache(rn : string;var bitmap : tbitmap) : boolean; var n : integer; begin result:=false; for n:=0 to length(ResourceCache)-1 do begin if uppercase(rn)=uppercase(ResourceCache[n].name) then begin //if assigned(bitmap)=false then bitmap:=tbitmap.create; bitmap.assign(ResourceCache[n].bmp); result:=true; break; end; end; end; procedure loadjpegresource(hi : Cardinal;resname : string;dest : tbitmap); var sr : Tresourcestream; jpg : Tjpegimage; begin sr:=TresourceStream.create(hi,resname,RT_RCDATA); jpg:=Tjpegimage.create; jpg.loadfromstream(sr); jpg.DIBNeeded; sr.free; dest.assign(jpg); jpg.Free; end; function LoadSkinResource(name : string;skinname : string;blendcolor : tcolor;IsJPEG : boolean) : tbitmap; var bmp : TBitmap; begin bmp :=TBitmap.create; if (getimagefromcache(name,bmp)=false) then begin if IsJPEG=false then bmp.LoadFromResourceName(initskin(skinname),name) else loadjpegresource(initskin(skinname),name,bmp); setlength(ResourceCache,length(ResourceCache)+1); ResourceCache[length(ResourceCache)-1].bmp:=tbitmap.create; if (blendcolor<>clnone) and (blendcolor<>0) then addcolortobitmap(bmp,blendcolor,alphaamount); ResourceCache[length(ResourceCache)-1].bmp.Assign(bmp); ResourceCache[length(ResourceCache)-1].name:=name; result:=(ResourceCache[length(ResourceCache)-1].bmp); end else result:=bmp; if DLLInstance<>0 then freelibrary(DLLInstance); end; function ReplaceSkinResource(name : string;skinname : string;blendcolor : tcolor;IsJPEG : boolean) : tbitmap; var bmp : TBitmap; n : integer; begin result:=nil; bmp :=TBitmap.create; if (getimagefromcache(name,bmp)=true) then begin if IsJPEG=false then bmp.LoadFromResourceName(initskin(skinname),name) else loadjpegresource(initskin(skinname),name,bmp); if (blendcolor<>clnone) and (blendcolor<>0) then addcolortobitmap(bmp,blendcolor,alphaamount); for n:=0 to length(ResourceCache)-1 do begin if uppercase(name)=uppercase(ResourceCache[n].name) then begin ResourceCache[n].bmp.assign(bmp); result:=ResourceCache[n].bmp; break; end; end; end else begin result:=LoadSkinResource(name,skinname,blendcolor,IsJpeg); end; bmp.free; if DLLInstance<>0 then freelibrary(DLLInstance); end; procedure freeskinresources; var n : integer; begin for n := 0 to length(ResourceCache)-1 do ResourceCache[n].bmp.free; end; procedure LoadSkinResourceNoCache(name : string;skinname : string;blendcolor : tcolor;IsJPEG : boolean;obmp : Tbitmap); var bmp : TBitmap; begin bmp := Tbitmap.create; if IsJPEG=false then bmp.LoadFromResourceName(initskin(skinname),name) else loadjpegresource(initskin(skinname),name,bmp); if (blendcolor<>clnone) and (blendcolor<>0) then addcolortobitmap(bmp,blendcolor,alphaamount); obmp.Assign(bmp); bmp.free; if DLLInstance<>0 then freelibrary(DLLInstance); end; function getline(ln : string;var param : String;var value : String) : boolean; var p : integer; begin result:=false; p:=pos('=',ln); if p=0 then begin param:=''; value:=''; exit; end; param:=TRIM(copy(ln,1,p-1)); value:=TRIM(copy(ln,p+1,length(ln)-(p-1))); result:=true; end; Procedure loadtheme(fn : string;var theme : TThemeSubset;var name : String); {cbut=1201394 skeypad= ckeypad=300545 slcorner= clcorner=453434 srcorner= crcorner=459495 sblcorner= cblcorner=45342 sbrcorner= cbrcorner=43434 salphabuttons= calphabuttons=121 swidebut= cwidebut=343434 sbackground=TEST cbackground=0 alphaorientation=2 } var DLLInstance : Cardinal; ms : TResourceStream; ts : TStringList; n : integer; c : integer; param,value: string; begin DLLInstance:=LoadLibrary(pansichar(fn)); if DLLInstance=0 then exit; ms:=TResourceStream.Create(DLLInstance,'INFO',RT_RCDATA); ts:=TStringList.Create; ts.LoadFromStream(ms); ms.free; name:=ts[0]; n:=1; c:=0; while n<ts.Count do begin if getline(ts[n],param,value)=true then begin if param='THEMENAME' then begin setlength(theme,c+1); theme[c].name:=value; inc(c); end; if param='sbut' then begin theme[c-1].sbut.Skin:=value; end; if param='cbut' then begin theme[c-1].sbut.Color:=strtoint(value); end; if param='skeypad' then begin theme[c-1].skeypad.Skin:=value; end; if param='ckeypad' then begin theme[c-1].skeypad.Color:=strtoint(value); end; if param='slcorner' then begin theme[c-1].slcorner.Skin:=value; end; if param='clcorner' then begin theme[c-1].slcorner.Color:=strtoint(value); end; if param='srcorner' then begin theme[c-1].srcorner.Skin:=value; end; if param='crcorner' then begin theme[c-1].srcorner.Color:=strtoint(value); end; if param='sblcorner' then begin theme[c-1].sblcorner.Skin:=value; end; if param='cblcorner' then begin theme[c-1].sblcorner.Color:=strtoint(value); end; if param='sbrcorner' then begin theme[c-1].sbrcorner.Skin:=value; end; if param='cbrcorner' then begin theme[c-1].sbrcorner.Color:=strtoint(value); end; if param='salphabuttons' then begin theme[c-1].salphabuttons.Skin:=value; end; if param='calphabuttons' then begin theme[c-1].salphabuttons.Color:=strtoint(value); end; if param='swidebut' then begin theme[c-1].swidebut.Skin:=value; end; if param='cwidebut' then begin theme[c-1].swidebut.Color:=strtoint(value); end; if param='sbackround' then begin theme[c-1].sbackground.Skin:=value; end; if param='cbackground' then begin theme[c-1].sbackground.Color:=strtoint(value); end; if param='alphaorientation' then begin theme[c-1].alphaorientation:=strtoint(value); end; end; inc(n); end; ts.free; freelibrary(DLLInstance); end; end.