?? sskinmanager.pas
字號:
FreeAndNil(ma[i].Bmp);
for j := i to l - 2 do begin
ma[j].ClassName := ma[j + 1].ClassName;
ma[j].PropertyName := ma[j + 1].PropertyName;
ma[j].Bmp := ma[j + 1].Bmp;
end;
SetLength(ma, l - 1);
Break;
end;
end;
end;
end;
end;
end
else begin
if pos('.BMP', UpperCase(FileName)) > 0 then begin
l := Length(ma);
if l > 0 then begin
for i := 0 to l - 1 do begin
if (UpperCase(ma[i].PropertyName) = s) and
(UpperCase(ma[i].ClassName) = UpperCase(skinSection)) then begin
ma[i].Bmp.LoadFromFile(FileName);
Result := True;
Exit;
end;
end;
end;
end;
end;
end;
constructor TsSkinManager.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBuiltInSkins := TsStoredSkins.Create(Self);
if FSkinDirectory = '' then begin
FSkinDirectory := DefSkinsDir;
end;
if FSkinName = '' then begin
if DirExists(FSkinDirectory + '/' + DefSkinsName) then begin
FSkinName := DefSkinsName;
end;
end;
FActive := True;
FSkinableMenus := TsSkinableMenus.Create(Self);
if sSkinData.SkinManager = nil then begin
sSkinData.SkinManager := Self;
end
else begin
ShowWarning('Please, be sure that only one exemplar of TsSkinManager component is present in project.');
end;
end;
destructor TsSkinManager.Destroy;
begin
if Assigned(FBuiltInSkins) then FreeAndNil(FBuiltInSkins);
if sSkinData.SkinManager = Self then begin
SendRemoveSkin;
sSkinData.SkinManager := nil;
end;
if Assigned(FSkinableMenus) then FreeAndNil(FSkinableMenus);
inherited Destroy;
end;
procedure TsSkinManager.ExtractByIndex(Index: integer; DestDir: string);
var
i : integer;
DirName : string;
sf : TMemIniFile;
begin
DirName := NormalDir(DestDir) + InternalSkins[Index].Name + ' extracted\';
if not DirectoryExists(DirName) then begin
if not CreateDir(DirName) then begin
ShowError('Directory ' + DirName + ' creation error.');
Exit;
end;
end;
sf := TMemIniFile.Create(DirName + 'Options.dat');
try
// Extract Bmp's
for i := 0 to InternalSkins[Index].Images.Count - 1 do begin
if InternalSkins[Index].Images[i].Name <> '' then begin
InternalSkins[Index].Images[i].Image.SaveToFile(DirName + InternalSkins[Index].Images[i].Name);
WriteIniStr(InternalSkins[Index].Images[i].SectionName, InternalSkins[Index].Images[i].PropertyName, InternalSkins[Index].Images[i].Name, sf);
end
else begin
ShowError('Images in this skin are not contains information about filenames. Please, reload skin.');
Break;
end;
end;
// Extract Jpeg's
for i := 0 to InternalSkins[Index].Patterns.Count - 1 do begin
if InternalSkins[Index].Patterns[i].Name <> '' then begin
InternalSkins[Index].Patterns[i].Image.SaveToFile(DirName + InternalSkins[Index].Patterns[i].Name);
WriteIniStr(InternalSkins[Index].Patterns[i].SectionName, InternalSkins[Index].Patterns[i].PropertyName, InternalSkins[Index].Patterns[i].Name, sf);
end;
end;
// Extract Ini
SaveToIni(Index, sf);
finally
sf.UpdateFile;
FreeAndNil(sf);
end;
end;
procedure TsSkinManager.ExtractInternalSkin(NameOfSkin, DestDir: string);
var
i : integer;
Executed : boolean;
// s : string;
begin
Executed := False;
for i := 0 to InternalSkins.Count - 1 do begin
if InternalSkins[i].Name = NameOfskin then begin
if DirectoryExists(Destdir) then begin
ExtractByIndex(i, Destdir);
end
else begin
ShowError('Directory with such name do not exists.');
end;
Executed := True;
end;
end;
if not Executed then begin
ShowError('Skin with such name do not exists.');
end;
end;
function TsSkinManager.GetExternalSkinNames(sl: TStrings): string;
var
FileInfo: TSearchRec;
DosCode: Integer;
s : string;
SkinPath : string;
begin
Result := '';
SkinPath := GetFullskinDirectory;
sl.Clear;
// External skins names loading
if DirExists(SkinPath) then begin
s := SkinPath + '\*.*';
DosCode := FindFirst(s, faDirectory, FileInfo);
try
while DosCode = 0 do begin
if (FileInfo.Name[1] <> '.') and (FileInfo.Attr and faDirectory = faDirectory) then begin
sl.Add(FileInfo.Name);
if Result = '' then Result := FileInfo.Name;
end;
DosCode := FindNext(FileInfo);
end;
finally
FindClose(FileInfo);
end;
end;
end;
function TsSkinManager.GetFullskinDirectory: string;
begin
Result := SkinDirectory;
if (pos('.\', Result) = 1) or (pos('./', Result) = 1) then begin
Delete(Result, 1, 2);
Result := GetAppPath + Result;
end
else if (pos(':', Result) < 1) then begin
Result := GetAppPath + Result;
end;
NormalDir(Result);
end;
function TsSkinManager.GetSkinNames(sl: TStrings) : string;
var
FileInfo: TSearchRec;
DosCode: Integer;
s : string;
SkinPath : string;
begin
Result := '';
SkinPath := GetFullskinDirectory;
sl.Clear;
// Internal skins names loading
if InternalSkins.Count > 0 then begin
for DosCode := 0 to InternalSkins.Count - 1 do begin
sl.Add(InternalSkins[DosCode].Name);
if Result = '' then Result := InternalSkins[DosCode].Name;
end;
end;
// External skins names loading
if DirExists(SkinPath) then begin
s := SkinPath + '\*.*';
DosCode := FindFirst(s, faDirectory, FileInfo);
try
while DosCode = 0 do begin
if (FileInfo.Name[1] <> '.') and (FileInfo.Attr and faDirectory = faDirectory) then begin
sl.Add(FileInfo.Name);
if Result = '' then Result := FileInfo.Name;
end;
DosCode := FindNext(FileInfo);
end;
finally
FindClose(FileInfo);
end;
end;
end;
procedure TsSkinManager.GetSkinSections(sl: TStrings);
begin
if sSkinData.Active and (sSkinData.SkinFile <> nil) then sSkinData.SkinFile.ReadSections(sl);
end;
procedure TsSkinManager.Loaded;
var
M : TSMSkin;
i : integer;
begin
inherited;
if Active and (SkinName <> '') then begin
RestrictDrawing := False;
M.Msg := SM_SETNEWSKIN;
M.GroupIndex := GroupIndex;
M.Result := 0;
M.SkinManager := Self;
if csDesigning in ComponentState then begin
if (csLoading in ComponentState) or (csReading in ComponentState) then Exit;
for i := 0 to Screen.FormCount - 1 do begin
BroadCastS(Screen.Forms[i], M);
end;
end
else begin
AppBroadCastS(M);
end;
M.Msg := SM_REFRESH;
M.GroupIndex := GroupIndex;
M.Result := 0;
M.SkinManager := Self;
if csDesigning in ComponentState then begin
if (csLoading in ComponentState) or (csReading in ComponentState) then Exit;
for i := 0 to Screen.FormCount - 1 do begin
BroadCastS(Screen.Forms[i], M);
end;
end
else begin
AppBroadCastS(M);
end;
end;
end;
procedure TsSkinManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (AComponent is TMenuItem) then begin
// if not FSkinableMenus.IsTopLine(TMenuItem(AComponent)) then
// FSkinableMenus.InitItem(TMenuItem(AComponent), (Operation = opInsert) and sSkinData.Active and not (csDesigning in ComponentState));
end
else if (AComponent is TMainMenu) then begin
FSkinableMenus.InitMenuLine(TMainMenu(AComponent), Operation = opInsert);
end;
end;
procedure TsSkinManager.SaveToIni(Index: integer; sf: TMemIniFile);
var
gd : TsSkinGeneral;
i : integer;
s, SectionName : string;
begin
for i := 0 to InternalSkins[Index].GeneralData.Count - 1 do begin
gd := InternalSkins[Index].GeneralData.Items[i];
if gd.SectionName = '' then Continue;
SectionName := gd.SectionName;
s := gd.ParentClassName;
WriteIniStr(SectionName, ParentClassName, s, sf);
s := IntToStr(gd.PaintingColor);
WriteIniStr(SectionName, PaintingColor, s, sf);
s := IntToStr(ord(gd.PaintingBevel));
WriteIniStr(SectionName, PaintingBevel, s, sf);
s := IntToStr(gd.PaintingBevelWidth);
WriteIniStr(SectionName, PaintingBevelWidth, s, sf);
s := IntToStr(gd.ShadowBlur);
WriteIniStr(SectionName, ShadowBlur, s, sf);
s := IntToStr(gd.ShadowOffset);
WriteIniStr(SectionName, ShadowOffset, s, sf);
s := IntToStr(gd.ShadowColor);
WriteIniStr(SectionName, ShadowColor, s, sf);
s := IntToStr(gd.ShadowTransparency);
WriteIniStr(SectionName, ShadowTransparency, s, sf);
s := iff(gd.ShadowEnabled, 'TRUE', 'FALSE');
WriteIniStr(SectionName, ShadowEnabled, s, sf);
s := iff(gd.ReservedBoolean, 'TRUE', 'FALSE');
WriteIniStr(SectionName, ReservedBoolean, s, sf);
s := ExtractWord(1, gd.FontColor, [' ']);
WriteIniStr(SectionName, FColor, s, sf);
s := ExtractWord(2, gd.FontColor, [' ']);
WriteIniStr(SectionName, TCLeft, s, sf);
s := ExtractWord(3, gd.FontColor, [' ']);
WriteIniStr(SectionName, TCTop, s, sf);
s := ExtractWord(4, gd.FontColor, [' ']);
WriteIniStr(SectionName, TCRight, s, sf);
s := ExtractWord(5, gd.FontColor, [' ']);
WriteIniStr(SectionName, TCBottom, s, sf);
s := ExtractWord(1, gd.HotFontColor, [' ']);
WriteIniStr(SectionName, HotFColor, s, sf);
s := ExtractWord(2, gd.HotFontColor, [' ']);
WriteIniStr(SectionName, HotTCLeft, s, sf);
s := ExtractWord(3, gd.HotFontColor, [' ']);
WriteIniStr(SectionName, HotTCTop, s, sf);
s := ExtractWord(4, gd.HotFontColor, [' ']);
WriteIniStr(SectionName, HotTCRight, s, sf);
s := ExtractWord(5, gd.HotFontColor, [' ']);
WriteIniStr(SectionName, HotTCBottom, s, sf);
s := IntToStr(gd.PaintingTransparency);
WriteIniStr(SectionName, PaintingTransparency, s, sf);
s := IntToStr(gd.GradientPercent);
WriteIniStr(SectionName, GradientPercent, s, sf);
s := IntToStr(gd.ImagePercent);
WriteIniStr(SectionName, ImagePercent, s, sf);
s := (gd.GradientData);
WriteIniStr(SectionName, GradientData, s, sf);
s := iff(gd.ShowFocus, 'TRUE', 'FALSE');
WriteIniStr(SectionName, ShowFocus, s, sf);
s := iff(gd.FadingEnabled, 'TRUE', 'FALSE');
WriteIniStr(SectionName, FadingEnabled, s, sf);
s := IntToStr(gd.FadingIntervalIn);
WriteIniStr(SectionName, FadingIntervalIn, s, sf);
s := IntToStr(gd.FadingIntervalOut);
WriteIniStr(SectionName, FadingIntervalOut, s, sf);
s := IntToStr(gd.FadingIterations);
WriteIniStr(SectionName, FadingIterations, s, sf);
s := IntToStr(gd.HotPaintingColor);
WriteIniStr(SectionName, HotPaintingColor, s, sf);
s := IntToStr(gd.HotPaintingTransparency);
WriteIniStr(SectionName, HotPaintingTransparency, s, sf);
s := IntToStr(ord(gd.HotPaintingBevel));
WriteIniStr(SectionName, HotPaintingBevel, s, sf);
s := IntToStr(gd.HotPaintingBevelWidth);
WriteIniStr(SectionName, HotPaintingBevelWidth, s, sf);
s := IntToStr(gd.HotGradientPercent);
WriteIniStr(SectionName, HotGradientPercent, s, sf);
s := gd.HotGradientData;
WriteIniStr(SectionName, HotGradientData, s, sf);
s := IntToStr(gd.HotImagePercent);
WriteIniStr(SectionName, HotImagePercent, s, sf);
s := IntToStr(gd.PaintingColorBorderTop);
WriteIniStr(SectionName, PaintingColorBorderTop, s, sf);
s := IntToStr(gd.PaintingColorBorderBottom);
WriteIniStr(SectionName, PaintingColorBorderBottom, s, sf);
s := IntToStr(gd.SelectionColor);
WriteIniStr(SectionName, SelectionColor, s, sf);
s := IntToStr(ord(gd.SelectionBorderBevel));
WriteIniStr(SectionName, SelectionBorderBevel, s, sf);
s := IntToStr(gd.SelectionBorderWidth);
WriteIniStr(SectionName, SelectionBorderWidth, s, sf);
end;
end;
procedure TsSkinManager.SendNewSkin;
var
M : TSMSkin;
i : integer;
begin
sSkinData.Active := False;
RestrictDrawing := True;
M.Msg := SM_CLEARINDEXES;
M.GroupIndex := GroupIndex;
M.Result := 0;
M.SkinManager := Self;
if csDesigning in ComponentState then begin
for i := 0 to Screen.FormCount - 1 do begin
BroadCastS(Screen.Forms[i], M);
end;
end
else begin
AppBroadCastS(M);
end;
sSkinData.Active := True;
M.Msg := SM_SETNEWSKIN;
M.GroupIndex := GroupIndex;
M.Result := 0;
M.SkinManager := Self;
if csDesigning in ComponentState then begin
for i := 0 to Screen.FormCount - 1 do begin
BroadCastS(Screen.Forms[i], M);
end;
end
else begin
AppBroadCastS(M);
end;
RestrictDrawing := False;
M.Msg := SM_REFRESH;
M.GroupIndex := GroupIndex;
M.Result := 0;
M.SkinManager := Self;
if (csLoading in ComponentState) or (csReading in ComponentState) then Exit;
if csDesigning in ComponentState then begin
for i := 0 to Screen.FormCount - 1 do begin
BroadCastS(Screen.Forms[i], M);
end;
end
else begin
AppBroadCastS(M);
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -