winskindata.pas

这是VCLSKIN v4.22 的所有的源代码

  bmp.canvas.FillRect(rect(0,0,bmp.width,bmp.height));

  w1 := GetSystemMetrics( SM_CXHSCROLL )+2;

  h:=21;
  r1:=rect(0,0,50,h);
  r2:=r1;
  r2.left := r1.right-w1;

  for i:= 1 to ComBoxborder.frame do begin
     DrawRect2(temp.canvas.Handle,r1,ComBoxborder.map,ComBoxborder.r,
        i,ComBoxborder.frame,ComBoxborder.trans);

     DrawRect2(temp.canvas.Handle,r2,ComBox.map,ComBox.r,
        i,ComBox.frame,1);
     if ExtraImages<>nil then
        DrawRect3(temp.canvas.Handle,r2,ExtraImages.map,
                  i,ExtraImages.frame,1);
     temp.canvas.FillRect(rect(2,2,50-w1-1,h-3));
     bmp.canvas.draw((i-1)*50,0,temp);
  end;
  combox.style:=2;
  combox.r := comboxborder.r;
  combox.r.right:=w1+2;
  combox.r.left:= 2;
  copybmp(bmp,combox.Map);//combox.Map.Assign(bmp);

  SpiegelnHorizontal(bmp);
  copybmp(bmp,comboxborder.Map);
  //ComBoxborder.Map.Assign(bmp);
  ComBoxborder.r.left:=w1+2;
  ComBoxborder.r.right:= 2;

  bmp.free;
  temp.free;
end;

procedure TSkinData.ReadTrack(var aobject:TDataSkinObject;aname:string);
begin
     if aobject<>nil then begin
       aobject.free;
       aobject:=nil;
     end;
     aobject:=TDataSkinObject.create(aname);
     aobject.Map.LoadFromResourceName(hinstance,aname);
     aobject.r:= Rect(3,3,3,3);
     aobject.Tile:= 0;
     aobject.frame:=1;
end;

function StrToWideStr(const S: AnsiString): WideString;
var
  InputLength,
  OutputLength: Integer;
begin
    InputLength := Length(S);
    OutputLength := MultiByteToWideChar(DefaultUserCodePage, 0, PAnsiChar(S), InputLength, nil, 0);
    SetLength(Result, OutputLength);
    MultiByteToWideChar(DefaultUserCodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength);
end;

function WideStringToStringEx(const WS: WideString): AnsiString;
var
  InputLength,
  OutputLength: Integer;
begin
    InputLength := Length(WS);
    OutputLength := WideCharToMultiByte(DefaultUserCodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil);
    SetLength(Result, OutputLength);
    WideCharToMultiByte(DefaultUserCodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil);
end;

function _WStr(lpString: PWideChar; cchCount: Integer): WideString;
begin
  if cchCount = -1 then
    Result := lpString
  else
    Result := Copy(WideString(lpString), 1, cchCount);
end;

function Tnt_DrawTextW(hDC: HDC; wString: WideString;var lpRect: TRect; uFormat: UINT): Integer;

var lpString:  PWideChar;
    ncount:integer;
begin
  lpstring:=PWideChar(wstring);
  ncount:=length(wstring);
  if Win32PlatformIsUnicode then
    Result := DrawTextW(hDC, lpString, nCount, lpRect, uFormat)
  else
    Result := DrawTextA(hDC,
      PAnsiChar(AnsiString(_WStr(lpString, nCount))), -1, lpRect, uFormat);
end;

function RGBToColor(R,G,B:Byte): TColor;
begin
  Result:=B Shl 16 Or
          G Shl 8  Or
          R;
end;

procedure CopyBMP(sbmp,dbmp:TBitMap);
begin
    dbmp.Width:=sbmp.Width;
    dbmp.Height:=sbmp.Height;
    dbmp.PixelFormat:=sbmp.PixelFormat;
    dbmp.Canvas.Draw(0,0,sbmp);
end;

function strcolor(s:string):Tcolor;
var i,j,l,n:integer;
    a:array[1..3]of integer;
    s2:string;
begin
   result:=0;
   if s='' then exit;
   s:=trim(s);
   l:=length(s);
   for i:=1 to 3 do a[i]:=0;
   j:=1;i:=1;s2:='';
   while (i<=l) do begin
     if s[i] in ['0'..'9'] then s2:=s2+s[i]
     else begin
        try
          if s2<>'' then begin
             a[j]:=strtoint(s2);
             inc(j);s2:='';
          end;
        except
        end;
        //inc(j);s2:='';
     end;
     inc(i);
   end;
   try
     if j=3 then a[3]:=strtoint(s2);
   except
   end;
   result:=rgb(a[1],a[2],a[3]);
end;

function FindControlx(Handle: HWnd): TWinControl;
begin
  Result := nil;
  if Handle <> 0 then  begin
{$ifdef COMPILER_6_UP}
   result:= pointer(SendMessage(handle, RM_GetObjectInstance, 0, 0));
{$else}
    Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)));
{$endif}
  end;
end;

function TSkinData.GetColor(const s1:string;acolor:Tcolor):Tcolor;
begin
   result:=acolor;
   if s1<>'' then result:=strcolor(s1);
end;

procedure TSkinData.ReadColor;
var s,s1:string;
    n,i:integer;
    b,r,g:byte;
begin
//  TShemeColor=(csText,csTitleTextActive,csTitleTextNoActive,
//         csButtonFace,csSelectText,csSelectBg,csTextDisable);
   s:='Colours';
   s1:=ini.readstring(s,'ButtonFace','');
   colors[csText]:=getcolor(ini.readstring(s,'WindowText',''),clWindowText);
   colors[csButtonFace]:=getcolor(ini.readstring(s,'ButtonFace',''),clBtnFace);
   colors[csScrollbar]:=getcolor(ini.readstring(s,'Scrollbar',''),clscrollbar);
   colors[csHilightText]:=getcolor(ini.readstring(s,'HilightText',''),clHighlightText);
   colors[csHilight]:=getcolor(ini.readstring(s,'Hilight',''),clHighlight);
   colors[csMenuBar]:=getcolor(ini.readstring(s,'Menubar',''),colors[csButtonFace]);
   colors[csMenuBG]:=getcolor(ini.readstring(s,'Menu',''),clMenu);
   colors[csMenuText]:=getcolor(ini.readstring(s,'MenuText',''),clMenuText);
   colors[csButtonText]:=getcolor(ini.readstring(s,'ButtonText',''),clBtnText);
   colors[csButtonHilight]:=getcolor(ini.readstring(s,'ButtonHilight',''),clBtnHighlight);
   colors[csButtonlight]:=getcolor(ini.readstring(s,'Buttonlight',''),clBtnHighlight);
   colors[csButtonShadow]:=getcolor(ini.readstring(s,'ButtonShadow',''),clBtnShadow);
   colors[csButtonDkShadow]:=getcolor(ini.readstring(s,'ButtonDkShadow',''),cl3DDkShadow);
   colors[csMenuBarText]:=getcolor(ini.readstring(s,'MenuBarText',''),clMenuText);
   colors[csTitleTextActive]:=getcolor(ini.readstring(s,'TitleTextActive',''),clcaptionText);
   colors[csTitleTextNoActive]:=getcolor(ini.readstring(s,'TitleTextNoActive',''),clinactivecaptionText);

   ini.ReadSections(sectionlist);
   for i:= sectionlist.count-1 downto 0 do begin
      s:=Uppercase(sectionlist.strings[i]);
      if (s='COLOURS') or (pos('COLOUR',s)<>1) then
         sectionlist.delete(i);
   end;
   n:=sectionlist.count;
   setlength(colorPreset,n);
   for i:=0 to n-1 do begin
     s:=Uppercase(sectionlist.strings[i]);
     colorPreset[i]:=getcolor(ini.readstring(s,'color',''),clWindowText);
   end;

//   setlength(colorPreset,10);
   for i:= 0 to high(PresetColors) do begin
      PresetColors[i] := getcolor(ini.readstring('Customcolors','Color'+inttostr(i),''),clwhite);
   end;
{//  TShemeColor=(csText,csTitleTextActive,csTitleTextNoActive,
//   ReadRGB('Personality','MenuText',colors[csMenuBarText]);
//   ReadRGB('Personality','ActiveText',colors[csTitleTextActive]);
//   ReadRGB('Personality','InactiveText',colors[csTitleTextNoActive]);

   n:=getsectionnum('Colour','B');
   setlength(colorPreset,n);
   for i:=0 to n-1 do begin
     r:=ini.readinteger(format('Colour%1d',[i]),'R',0);
     g:=ini.readinteger(format('Colour%1d',[i]),'G',0);
     b:=ini.readinteger(format('Colour%1d',[i]),'B',0);
     colorPreset[i]:=rgbtocolor(r,g,b);
   end;}
end;

Procedure TSkinData.ReadRGB(Section,aname:string;var value:Tcolor);
var a:array[1..3] of integer;
    R : Array [1..3] of string;
    i:integer;
begin
    R[1]:='R';R[2]:='G';R[3]:='B';
    for i:= 1 to 3 do begin
        a[i]:=ini.readinteger(section,aname+r[i],-1);
    end;
    if (a[1]>=0) and (a[2]>=0) and (a[3]>=0) then
    value:=rgb(a[1],a[2],a[3]);
//    value:=RGBToColor(a[1],a[2],a[3]);
end;

function TSkinData.GetSectionNum(asection,aname:string):integer;
var i:integer;
    s:string;
begin
   i:=0;
   s:=ini.readstring(format('%s%1d',[asection,i]),aname,'');
   while s<>'' do begin
      inc(i);
      s:=ini.readstring(format('%s%1d',[asection,i]),aname,'');
   end;
   result:=i;
end;

procedure TSkinData.Uninstall;
begin
    SkinManager.setaction(skin_Uninstall);
end;

procedure TSkinData.Install;
begin
    SkinManager.setaction(skin_Active);
end;

procedure TSkinData.DoFormSkin(ahwnd:Thandle;aname:string;var Doskin:boolean);
begin
    formhwnd:=ahwnd;
    if assigned(fOnformskin) then fOnformskin(self,aname,doskin)
//    else if aname='TQRStandardPreview' then doskin:=false
    else if aname='SysMonthCal32' then doskin:=false
//    else if aname='TppPrintPreview' then doskin:=false
//    else if aname='TdxfmStdPreview' then doskin:=false
    else if (xcFastReport in SkinControls) and (pos('Tfr',aname)=1) then doskin:=false;
end;

procedure TSkinData.DoSkinChanged;
begin
    if assigned(fOnSkinChanged) then
      fOnSkinChanged(self);
end;

procedure TSkinData.AddNestForm(fParent,fNested:TWincontrol);
var i:integer;
    sf :TWinSkinform;
    spy:TWinSkinspy;
begin
   if fNested=nil then exit;
   for i:=0 to SkinManager.flist.count-1 do begin
      sf:=TWinSkinform(SkinManager.flist[i]);
      if sf.hwnd=fParent.handle then begin
         spy := TWinSkinspy.Create(fNested);
         spy.sf:=sf;
//         sf.InitControls(fparent);
         sf.InitNestform(Tform(fNested));
         break;
      end;
   end;
end;

procedure TSkinData.UpdateSkinControl(fParent:Tform;acontrol:Twincontrol=nil);
var i:integer;
    sf :TWinSkinform;
begin
   for i:=0 to SkinManager.flist.count-1 do begin
      sf:=TWinSkinform(SkinManager.flist[i]);
      if sf.hwnd=fParent.handle then begin
         if acontrol=nil then  sf.InitControls(fparent)
         else sf.InitControls(acontrol);
         break;
      end;
   end;
end;

procedure TSkinData.ChangeForm(aform:Tform);
begin
//   postmessage(skinmanager.handle,CN_SkinNotify,skin_update,aform.handle);
    skinmanager.lpara:=aform.handle;
    skinmanager.UpdateData:=self;
    skinmanager.setaction(skin_update);
end;

procedure TSkinData.DoDebug(s:string);
begin
  if debuglist<>nil then
       debuglist.Add(s);
end;

procedure TSkinData.EnableSkin(b:boolean);
begin
   skinmanager.active:=b;
end;

procedure TSkinData.DeleteGraphicControl(fParent:Tform;acontrol:TGraphicControl);
var i,j:integer;
    sf :TWinSkinform;
    sc:Tskincontrol;
begin
   for i:=0 to SkinManager.flist.count-1 do begin
      sf:=TWinSkinform(SkinManager.flist[i]);
      if sf.hwnd=fParent.handle then begin
         for j:= 0 to sf.controllist.count-1 do begin
            sc:= Tskincontrol(sf.controllist.items[j]);
            if sc.GControl = acontrol then begin
               sf.controllist.Delete(j);
               sc.free;
               break;
            end;
         end;
      end;
   end;
end;

procedure TSkinData.SkinForm(ahwnd:THandle);
begin
   SkinManager.skinchildform:=true;
   SkinManager.addform(ahwnd);
   SkinManager.skinchildform:=false;
end;

procedure TSkinData.UpdateMenu(fParent:Tform);
var i:integer;
    sf :TWinSkinform;
begin
   for i:=0 to SkinManager.flist.count-1 do begin
      sf:=TWinSkinform(SkinManager.flist[i]);
      if sf.hwnd=fParent.handle then begin
         sf.InitPopMenu(fParent,true,true);
         break;
      end;
   end;
end;

procedure TSkinData.UpdateMainMenu(done:boolean);
var i:integer;
    sf :TWinSkinform;
begin
   menumsg:=done;
   if not menumsg then exit;
   for i:=0 to SkinManager.flist.count-1 do begin
      sf:=TWinSkinform(SkinManager.flist[i]);
      if (sf.menu<>nil) then begin
         sf.menu.updatabtn;
         //break;
      end;
   end;
end;

procedure TSkinData.InstallThread(aThreadID:integer);
begin
   skinmanager.installthread(athreadid);
end;

procedure TSkinData.UnInstallThread(aThreadID:integer);
begin
    SkinManager.UnInstallThread(aThreadID);
end;

procedure TSkinData.LoadFromFile(value:string);
begin
   empty:=true;
   fskinfile:=value;
   if (csDesigning in ComponentState) then begin
    if (value<>'') and (data.size>0) then data.clear;