Delphi控件源码

开发平台：

Delphi

DynamicSkinForm.pas：源码内容

Parent.DSF.SkinMenu.Hide;
Parent.DSF.SkinMenuClose;
DS.FForm.Close;
end;
end;
procedure TspSkinMainMenuBarButton.DoCommand;
var
DS: TspDynamicSkinForm;
MI: TMenuItem;
R: TRect;
P: TPoint;
begin
DS := GetMDIChildDynamicSkinFormComponent;
if DS <> nil
then
case Command of
cmClose: DS.FForm.Close;
cmMinimize: DS.WindowState := wsMinimized;
cmMaximize: DS.WindowState := wsNormal;
cmSysMenu:
begin
Parent.RePaint;
P := Point(ObjectRect.Left, ObjectRect.Top);
P := Parent.ClientToScreen(P);
R := Rect(P.X, P.Y, P.X + RectWidth(ObjectRect), P.Y + RectHeight(ObjectRect));
MI := DS.GetSystemMenu;
Parent.DSF.SkinMenuOpen;
if Parent.DSF.MenusSkinData = nil
then
Parent.DSF.SkinMenu.Popup(Parent, Parent.DSF.SkinData, 0, R, MI, Parent.PopupToUp)
else
Parent.DSF.SkinMenu.Popup(Parent, Parent.DSF.MenusSkinData, 0, R, MI, Parent.PopupToUp);
end;
end;
end;
procedure TspSkinMainMenuBarButton.MouseDown;
begin
if not Enabled then Exit;
if (Button <> mbLeft)
then
begin
inherited MouseDown(X, Y, Button);
Exit;
end;
if not FDown
then
begin
FDown := True;
if Morphing and not IsNullRect(DownRect) then MorphKf := 1;
Parent.DrawSkinObject(Self);
if Command = cmSysMenu then DoCommand;
end;
end;
procedure TspSkinMainMenuBarButton.MouseUp;
begin
if not Enabled then Exit;
if (Button <> mbLeft)
then
begin
inherited MouseUp(X, Y, Button);
Exit;
end;
inherited MouseUp(X, Y, Button);
if (Command <> cmSysMenu)
then
begin
FDown := False;
ReDraw;
end;
if Active and (Command <> cmSysMenu) then DoCommand;
end;
// ==============TspSkinMainMenuBar =============//
constructor TspSkinMainMenuBarItem.Create;
begin
inherited Create(AParent, AData);
if AData <> nil
then
begin
FSkinSupport := True;
with TspDataSkinMainMenuBarItem(AData) do
begin
Self.FontName := FontName;
Self.FontHeight := FontHeight;
Self.FontStyle := FontStyle;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.TextRct := TextRct;
Self.DownRect := DownRect;
Self.LO := ItemLO;
Self.RO := ItemRO;
Self.UnEnabledFontColor := UnEnabledFontColor;
end;
if IsNullRect(DownRect) then
if IsNullRect(ActiveSkinRect)
then DownRect := SkinRect else DownRect := ActiveSkinRect;
if IsNullRect(ActiveSkinRect) then Morphing := False;
end
else
FSkinSupport := False;
OldEnabled := Enabled;
Visible := True;
end;
procedure TspSkinMainMenuBarItem.SearchActive;
var
i: Integer;
begin
for i := 0 to Parent.ObjectList.Count - 1 do
if (TspMenuBarObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuBarItem)
and (TspSkinMainMenuBarItem(Parent.ObjectList.Items[i]).IDName <> IDName)
and (TspSkinMainMenuBarItem(Parent.ObjectList.Items[i]).Active)
then
begin
TspSkinMainMenuBarItem(Parent.ObjectList.Items[i]).MouseLeave;
Break;
end;
end;
function TspSkinMainMenuBarItem.SearchDown;
var
i: Integer;
begin
Result := False;
for i := 0 to Parent.ObjectList.Count - 1 do
if (TspMenuBarObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuBarItem)
and (TspSkinMainMenuBarItem(Parent.ObjectList.Items[i]).IDName <> IDName)
and (TspSkinMainMenuBarItem(Parent.ObjectList.Items[i]).FDown)
then
begin
TspSkinMainMenuBarItem(Parent.ObjectList.Items[i]).SetDown(False);
Result := True;
Break;
end;
end;
procedure TspSkinMainMenuBarItem.DefaultDraw;
function CalcObjectRect(Cnvs: TCanvas): TRect;
var
w, i, j: Integer;
R, TR: TRect;
begin
w := 2;
Cnvs.Font.Assign(Parent.DefItemFont);
TR := Rect(0, 0, 0, 0);
DrawText(Cnvs.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CALCRECT or DT_CENTER);
w := w + RectWidth(TR) + 10;
R := Rect(0, 0, 0, 0);
j := Parent.ObjectList.IndexOf(Self);
for i := j - 1 downto 0 do
if TspMenuBarObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
begin
R.Left := TspMenuBarObject(Parent.ObjectList.Items[i]).ObjectRect.Right;
Break;
end;
if R.Left = 0 then R.Left := Parent.NewItemsRect.Left;
R.Top := Parent.NewItemsRect.Top;
R.Right := R.Left + w;
R.Bottom := Parent.NewItemsRect.Bottom;
Result := R;
end;
var
Buffer: TBitMap;
R, R1: TRect;
TMO: Integer;
begin
Buffer := TBitMap.Create;
ObjectRect := CalcObjectRect(Buffer.Canvas);
if Parent.ScrollMenu
then
TMO := TRACKMARKEROFFSET
else
TMO := 0;
if ObjectRect.Right > Parent.NewItemsRect.Right - TMO
then
begin
Parent.Scroll := True;
if Visible
then
begin
OldEnabled := Enabled;
Enabled := False;
Visible := False;
end;
Buffer.Free;
Exit;
end
else
if not Visible
then
begin
Visible := True;
Enabled := OldEnabled;
end;
Buffer.Width := RectWidth(ObjectRect);
Buffer.Height := RectHeight(ObjectRect);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
if FDown
then
begin
Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
FillRect(R);
end
else
if FMouseIn
then
begin
Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNACTIVECOLOR;
FillRect(R);
end
else
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
//
R1 := Rect(0, 0, 0, 0);
Buffer.Canvas.Font.Assign(Parent.DefItemFont);
DrawText(Buffer.Canvas.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), R1, DT_CALCRECT);
R.Top := R.Top + RectHeight(R) div 2 - R1.Bottom div 2;
R.Bottom := R.Top + R1.Bottom;
if FDown
then
begin
Inc(R.Left);
Inc(R.Top);
end;
DrawText(Buffer.Canvas.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), R, DT_CENTER or DT_VCENTER);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
Buffer.Free;
end;
procedure TspSkinMainMenuBarItem.Draw;
function CalcObjectRect(Cnvs: TCanvas): TRect;
var
w, i, j: Integer;
R, TR: TRect;
begin
w := TextRct.Left + RectWidth(SkinRect) - TextRct.Right;
with Cnvs do
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
Font.CharSet := Parent.DefItemFont.Charset;
end;
TR := Rect(0, 0, 0, 0);
DrawText(Cnvs.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CALCRECT or DT_CENTER);
w := w + RectWidth(TR) + 2;
R := Rect(0, 0, 0, 0);
j := Parent.ObjectList.IndexOf(Self);
for i := j - 1 downto 0 do
if TspMenuBarObject(Parent.ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
begin
R.Left := TspMenuBarObject(Parent.ObjectList.Items[i]).ObjectRect.Right;
Break;
end;
if R.Left = 0 then R.Left := Parent.NewItemsRect.Left;
R.Top := Parent.NewItemsRect.Top;
R.Right := R.Left + w;
R.Bottom := R.Top + RectHeight(SkinRect);
Result := R;
end;
procedure CreateItemImage(B: TBitMap; Rct: TRect; AActive: Boolean);
var
XO, w, XCnt: Integer;
TR: TRect;
X: Integer;
begin
if Picture = nil then Exit;
B.Width := RectWidth(ObjectRect);
B.Height := RectHeight(ObjectRect);
with B.Canvas do
begin
if LO <> 0 then
CopyRect(Rect(0, 0, LO, B.Height), Picture.Canvas,
Rect(Rct.Left, Rct.Top, Rct.Left + LO, Rct.Bottom));
if RO <> 0 then
CopyRect(Rect(B.Width - RO, 0, B.Width, B.Height),
Picture.Canvas,
Rect(Rct.Right - RO, Rct.Top, Rct.Right, Rct.Bottom));
Inc(Rct.Left, LO);
Dec(Rct.Right, RO);
w := RectWidth(Rct);
XCnt := (B.Width - LO - RO) div w;
for X := 0 to XCnt do
begin
if LO + X * w + w > B.Width - RO
then XO := LO + X * w + w - (B.Width - RO)
else XO := 0;
B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
B.Height),
Picture.Canvas,
Rect(Rct.Left, Rct.Top, Rct.Right - XO, Rct.Bottom));
end;
Brush.Style := bsClear;
if FDown
then
Font.Color := DownFontColor
else
if AActive
then
Font.Color := ActiveFontColor
else
if Self.MenuItem.Enabled
then Font.Color := FontColor
else Font.Color := UnEnabledFontColor;
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
Font.CharSet := Parent.DefItemFont.Charset;
TR := TextRct;
DrawText(B.Canvas.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CALCRECT);
Inc(TR.Right, 2);
DrawText(B.Canvas.Handle, PChar(MenuItem.Caption),
Length(MenuItem.Caption), TR, DT_CENTER or DT_VCENTER);
end;
end;
var
Buffer, ABuffer: TBitMap;
PBuffer, APBuffer: TspEffectBmp;
TMO: Integer;
begin
if not FSkinSupport
then
begin
DefaultDraw(Cnvs);
Exit;
end;
if IsNullRect(SkinRect) or IsNullRect(TextRct) then Exit;
Buffer := TBitMap.Create;
ObjectRect := CalcObjectRect(Buffer.Canvas);
if Parent.ScrollMenu
then
TMO := TRACKMARKEROFFSET
else
TMO := 0;
if ObjectRect.Right > Parent.NewItemsRect.Right - TMO
then
begin
Parent.Scroll := True;
if Visible
then
begin
OldEnabled := Enabled;
Enabled := False;
Visible := False;
end;
Buffer.Free;
Exit;
end
else
if not Visible
then
begin
Visible := True;
Enabled := OldEnabled;
end;
if FDown
then
begin
CreateItemImage(Buffer, DownRect, True);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
end
else
if not Morphing or
((Active and (MorphKf = 1)) or (not Active and (MorphKf = 0)))
then
begin
if Active
then
begin
if isNullRect(ActiveSkinRect)
then
CreateItemImage(Buffer, SkinRect, True)
else
CreateItemImage(Buffer, ActiveSkinRect, True);
end
else CreateItemImage(Buffer, SkinRect, False);
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
end
else
begin
CreateItemImage(Buffer, SkinRect, False);
ABuffer := TBitMap.Create;
CreateItemImage(ABuffer, ActiveSkinRect, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, MorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
end;
PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
PBuffer.Free;
APBuffer.Free;
ABuffer.Free;
end;
Buffer.Free;
end;
procedure TspSkinMainMenuBarItem.MouseEnter;
begin
if SearchDown
then
begin
Active := True;
FMouseIn := True;
if Morphing then MorphKf := 1;
SetDown(True);
end
else
begin
SearchActive;
FMouseIn := True;
Active := True;
ReDraw;
if Assigned(Parent.OnItemMouseEnter)
then
Parent.OnItemMouseEnter(Self.MenuItem);
end;
end;
procedure TspSkinMainMenuBarItem.MouseLeave;
begin
Active := False;
FMouseIn := False;
if Morphing and FDown then MorphKf := 0;
Redraw;
if Assigned(Parent.OnItemMouseLeave)
then
Parent.OnItemMouseLeave(Self.MenuItem);
end;
procedure TspSkinMainMenuBarItem.SetDown;
begin
FDown := Value;
if FDown
then
begin
Parent.DrawSkinObject(Self);
if Parent.DSF <> nil
then
with Parent.DSF do
begin
if not InMainMenu
then
begin
if Assigned(OnMainMenuEnter) then OnMainMenuEnter(Parent);
end;
end;
TrackMenu;
end
else
begin
Active := False;
if Morphing
then
begin
FMorphKf := 1;
ReDraw;
end
else
Parent.DrawSkinObject(Self);
end;
end;
procedure TspSkinMainMenuBarItem.TrackMenu;
var
R: TRect;
P: TPoint;
begin
P := Point(ObjectRect.Left, ObjectRect.Top);
P := Parent.ClientToScreen(P);
R := Rect(P.X, P.Y, P.X + RectWidth(ObjectRect), P.Y + RectHeight(ObjectRect));
if Parent.DSF <> nil
then
with Parent.DSF do
begin
SkinMenuOpen;
if not InMainMenu then InMainMenu := True;
SkinMenu.Popup(nil, Parent.SkinData, 0, R, MenuItem, Parent.PopupToUp);
end;
end;
procedure TspSkinMainMenuBarItem.MouseDown;
var
Menu: TMenu;
begin
if not Enabled then Exit;
if Button = mbLeft
then
begin
if Assigned(Parent.OnMainMenuItemClick)
then
Parent.OnMainMenuItemClick(IDName);
if MenuItem.Count <> 0
then
begin
Parent.MenuActive := True;
SetDown(True);
end
else
begin
if Parent.DSF.InMainMenu
then
Parent.DSF.SkinMainMenuClose;
Parent.DSF.InMenu := False;
if Morphing then ReDraw else Parent.DrawSkinObject(Self);
Menu := MenuItem.GetParentMenu;
Menu.DispatchCommand(MenuItem.Command);
end;
end;
end;
constructor TspSkinMainMenuBar.Create(AOwner: TComponent);
begin
inherited;
FScrollMenu := True;
FSkinDataName := 'mainmenubar';
FSkinSupport := False;
Align := alTop;
FDefaultHeight := 22;
Height := 22;
MouseTimer := TTimer.Create(Self);
MouseTimer.Enabled := False;
MouseTimer.OnTimer := TestMouse;
MouseTimer.Interval := MouseTimerInterval;
MorphTimer := TTimer.Create(Self);
MorphTimer.Enabled := False;
MorphTimer.OnTimer := TestMorph;
MorphTimer.Interval := MorphTimerInterval;
ObjectList := TList.Create;
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
DSF := nil;
MarkerActive := False;
MenuActive := False;
FPopupToUp := False;
FMDIChildMax := False;
ButtonsCount := 0;
FDefItemFont := TFont.Create;
with FDefItemFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
Color := clBtnText;
end;
end;
destructor TspSkinMainMenuBar.Destroy;
begin
FDefItemFont.Free;
ClearObjects;
ObjectList.Free;
MouseTimer.Free;
MorphTimer.Free;
inherited;
end;
function TspSkinMainMenuBar.GetChildMainMenu: TMainMenu;
var
i: Integer;
begin
Result := nil;
if (Application.MainForm <> nil) and (Application.MainForm.ActiveMDIChild <> nil)
then
with Application.MainForm.ActiveMDIChild do
begin
for i := 0 to ComponentCount - 1 do
begin
if Components[i] is TMainMenu
then
begin
Result := TMainMenu(Components[i]);
Break;
end;
end;
end;
end;
procedure TspSkinMainMenuBar.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TspSkinMainMenuBar.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TspSkinMainMenuBar.SetDefItemFont;
begin
FDefItemFont.Assign(Value);
if FIndex = -1 then RePaint;
end;
procedure TspSkinMainMenuBar.WMCloseSkinMenu;
begin
CloseSysMenu;
end;
procedure TspSkinMainMenuBar.CloseSysMenu;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarButton then
with TspSkinMainMenuBarButton(ObjectList.Items[i]) do
if (Command = cmSysMenu) and FDown
then
begin
if ActiveObject <> i
then
begin
Active := False;
FMouseIn := False;
end;
FDown := False;
ReDraw;
end;
end;
procedure TspSkinMainMenuBar.CheckButtons;
var
i: Integer;
begin
for i := 0 to ButtonsCount - 1 do
with TspSkinMainMenuBarButton(ObjectList.Items[i]) do
begin
Enabled := True;
case Command of
cmMinimize: if not (biMinimize in BI) then Enabled := False;
cmSysMenu: if not (biSystemMenu in BI) then Enabled := False;
end;
end;
end;
procedure TspSkinMainMenuBar.AddButtons;
procedure AddButton(ButtonName: String);
var
ButtonData: TspDataSkinMainMenuBarButton;
Index: Integer;
begin
if (FSD = nil) or (FSD.Empty)
then
Index := -1
else
Index := FSD.GetIndex(ButtonName);
if Index <> -1
then
ButtonData := TspDataSkinMainMenuBarButton(FSD.ObjectList.Items[Index])
else
ButtonData := nil;
ObjectList.Insert(0, TspSkinMainMenuBarButton.Create(Self, ButtonData));
with TspSkinMainMenuBarButton(ObjectList.Items[0]) do
begin
IDName := ButtonName;
end;
Inc(ButtonsCount);
end;
begin
ButtonsCount := 0;
if FIndex <> -1
then
begin
AddButton(MinButton);
AddButton(MaxButton);
AddButton(CloseButton);
AddButton(SysMenuButton);
end
else
begin
AddButton('MinButton');
TspSkinMainMenuBarButton(ObjectList.Items[0]).Command := cmMinimize;
AddButton('MaxButton');
TspSkinMainMenuBarButton(ObjectList.Items[0]).Command := cmMaximize;
AddButton('CloseButton');
TspSkinMainMenuBarButton(ObjectList.Items[0]).Command := cmClose;
AddButton('SysMenuButton');
TspSkinMainMenuBarButton(ObjectList.Items[0]).Command := cmSysMenu;
end;
end;
procedure TspSkinMainMenuBar.DeleteButtons;
var
i: Integer;
begin
for i := 0 to ButtonsCount - 1 do
begin
ActiveObject := -1;
MouseCaptureObject := -1;
TspMenuBarObject(ObjectList.Items[0]).Free;
ObjectList.Delete(0);
end;
ButtonsCount := 0;
end;
procedure TspSkinMainMenuBar.MDIChildMaximize;
var
DS: TspDynamicSkinForm;
begin
if not FMDIChildMax
then
begin
FMDIChildMax := True;
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
AddButtons;
DS := GetMDIChildDynamicSkinFormComponent;
if DS <> nil then CheckButtons(DS.BorderIcons);
RePaint;
end;
end;
procedure TspSkinMainMenuBar.MDIChildRestore;
var
DS: TspDynamicSkinForm;
begin
DS := GetMDIChildDynamicSkinFormComponent;
if (DS = nil) and FMDIChildMax
then
begin
FMDIChildMax := False;
DeleteButtons;
RePaint;
end
else
if DS <> nil
then CheckButtons(DS.BorderIcons);
end;
function TspSkinMainMenuBar.GetMarkerRect;
begin
Result := Rect(NewItemsRect.Right - TRACKMARKEROFFSET, NewItemsRect.Top,
NewItemsRect.Right, NewItemsRect.Bottom);
end;
procedure TspSkinMainMenuBar.DrawMarker;
var
C: TColor;
begin
if FIndex <> -1
then
begin
if MarkerActive
then C := TrackMarkActiveColor
else C := TrackMarkColor;
end
else
begin
if MarkerActive
then C := clBtnText
else C := clBtnShadow;
end;
DrawArrowImage(Cnvs, GetMarkerRect, C, 2);
end;
procedure TspSkinMainMenuBar.TrackScrollMenu;
var
i, VisibleCount: Integer;
R: TRect;
P: TPoint;
ChildMainMenu: TMainMenu;
begin
if DSF = nil then Exit;
VisibleCount := 0;
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Visible then Inc(VisibleCount);
end;
P := Point(NewItemsRect.Right, NewItemsRect.Top);
P := ClientToScreen(P);
R := Rect(P.X - TRACKMARKEROFFSET, P.Y,
P.X, P.Y + RectHeight(NewItemsRect));
if DSF.FForm.FormStyle = fsMDIForm
then
ChildMainMenu := GetChildMainMenu
else
ChildMainMenu := nil;
DSF.SkinMenuOpen;
if ChildMainMenu = nil
then
DSF.SkinMenu.Popup(nil, FSD, VisibleCount, R, FMainMenu.Items, False)
else
DSF.SkinMenu.Popup2(nil, FSD, VisibleCount, R, FMainMenu.Items, ChildMainMenu.Items, False);
end;
function TspSkinMainMenuBar.FindHotKeyItem;
var
i: Integer;
begin
Result := False;
if (DSF <> nil) and (ObjectList <> nil) then
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible and
IsAccel(CharCode, MenuItem.Caption)
then
begin
MouseEnter;
if (not DSF.InMenu) or (MenuItem.Count = 0) then MouseDown(0, 0, mbLeft);
Result := True;
Break;
end;
end
end;
procedure TspSkinMainMenuBar.NextMainMenuItem;
function IsEndItem(Index: Integer): Boolean;
var
i: Integer;
begin
Result := True;
if Index + 1 > ObjectList.Count - 1
then
Result := True
else
for i := Index + 1 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible then Result := False;
end
end;
var
i, j: Integer;
EndI: Boolean;
FirstItem: Integer;
begin
EndI := False;
FirstItem := -1;
j := -1;
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
if FirstItem = -1 then FirstItem := i;
if (Active or FDown)
then
begin
j := i;
MouseLeave;
EndI := IsEndItem(j);
Break;
end;
end;
end;
if j = -1
then
begin
j := FirstItem;
if j <> -1 then
TspSkinMainMenuBarItem(ObjectList.Items[j]).MouseEnter;
end
else
begin
if EndI then j := 0 else j := j + 1;
if j < ObjectList.Count then
for i := j to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
MouseEnter;
Break;
end;
end;
end;
end;
procedure TspSkinMainMenuBar.PriorMainMenuItem;
function IsEndItem(Index: Integer): Boolean;
var
i: Integer;
begin
Result := True;
if Index - 1 < 0
then
Result := True
else
for i := Index - 1 downto 0 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible then Result := False;
end
end;
var
i, j: Integer;
EndI: Boolean;
LastItem: Integer;
begin
EndI := False;
j := -1;
LastItem := -1;
for i := ObjectList.Count - 1 downto 0 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
if LastItem = -1 then LastItem := i;
if Active or FDown then
begin
j := i;
MouseLeave;
EndI := IsEndItem(j);
Break;
end;
end;
end;
if j = -1
then
begin
j := LastItem;
if j <> -1 then
TspSkinMainMenuBarItem(ObjectList.Items[j]).MouseEnter;
end
else
begin
if EndI then j := ObjectList.Count - 1 else j := j - 1;
if j > -1 then
for i := j downto 0 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
MouseEnter;
Break;
end;
end;
end;
end;
function TspSkinMainMenuBar.CheckReturnKey;
var
i: Integer;
begin
Result := False;
if DSF <> nil then
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if (FDown and (MenuItem.Count = 0)) or
(Active and not DSF.InMenu)
then
begin
Active := False;
MouseDown(0, 0, mbLeft);
Result := True;
Break;
end;
end;
end;
procedure TspSkinMainMenuBar.MenuEnter;
var
i: Integer;
FirstItem: Integer;
begin
FirstItem := -1;
MenuActive := True;
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem
then
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if FirstItem = -1 then FirstItem := i;
if Active
then
begin
FirstItem := i;
Break;
end;
end;
if FirstItem <> -1
then
begin
TspSkinMainMenuBarItem(ObjectList.Items[FirstItem]).MouseEnter;
if DSF <> nil then
with DSF do
begin
HookApp;
InMainMenu := True;
if Assigned(OnMainMenuEnter) then OnMainMenuEnter(Self);
end;
end;
end;
procedure TspSkinMainMenuBar.MenuClose;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem then
begin
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
if FDown then
begin
FDown := False;
Active := True;
if Morphing then MorphKf := 1;
DrawSkinObject(TspSkinMainMenuBarItem(ObjectList.Items[i]));
Break;
end;
end;
end;
procedure TspSkinMainMenuBar.MenuExit;
var
i: Integer;
begin
MenuActive := False;
for i := 0 to ObjectList.Count - 1 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarItem then
begin
with TspSkinMainMenuBarItem(ObjectList.Items[i]) do
if FDown or Active then
begin
Active := False;
FMouseIn := False;
FDown := False;
if Morphing then MorphKf := 1;
ReDraw;
Break;
end;
end;
ActiveObject := -1;
OldActiveObject := -1;
end;
procedure TspSkinMainMenuBar.CalcRects;
var
Off: Integer;
i: Integer;
begin
if FSkinSupport
then
begin
Off := RectWidth(SkinRect) - ItemsRect.Right;
NewItemsRect := Rect(ItemsRect.Left, ItemsRect.Top, Width - Off, ItemsRect.Bottom);
end
else
NewItemsRect := Rect(2, 2, Width - 2, Height - 2);
if FMDIChildMax and (ButtonsCount = 4)
then
begin
if TspMenuBarObject(ObjectList.Items[0]) is TspSkinMainMenuBarButton
then
with TspSkinMainMenuBarButton((ObjectList.Items[0])) do
begin
if FSkinSupport
then
begin
ObjectRect := Rect(NewItemsRect.Left,
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2,
NewItemsRect.Left + RectWidth(SkinRect),
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2 +
RectHeight(SkinRect));
Inc(NewItemsRect.Left, RectWidth(SkinRect) + 2);
end
else
begin
ObjectRect := Rect(NewItemsRect.Left,
NewItemsRect.Top,
NewItemsRect.Left + RectHeight(NewItemsRect),
NewItemsRect.Bottom);
Inc(NewItemsRect.Left, RectHeight(NewItemsRect) + 2);
end;
end;
for i := 1 to 3 do
if TspMenuBarObject(ObjectList.Items[i]) is TspSkinMainMenuBarButton
then
with TspSkinMainMenuBarButton((ObjectList.Items[i])) do
begin
if FSkinSupport
then
begin
ObjectRect := Rect(NewItemsRect.Right - RectWidth(SkinRect),
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2,
NewItemsRect.Right,
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2 +
RectHeight(SkinRect));
Dec(NewItemsRect.Right, RectWidth(SkinRect) + 2);
end
else
begin
ObjectRect := Rect(NewItemsRect.Right - RectHeight(NewItemsRect),
NewItemsRect.Top,
NewItemsRect.Right,
NewItemsRect.Bottom);
Dec(NewItemsRect.Right, RectHeight(NewItemsRect) + 2);
end;
end;
end;
end;
procedure TspSkinMainMenuBar.DrawSkinObject;
begin
AObject.Draw(Canvas);
end;
procedure TspSkinMainMenuBar.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinMainMenuBar
then
with TspDataSkinMainMenuBar(FSD.CtrlList.Items[FIndex]) do
begin
Self.SkinRect := SkinRect;
Self.ItemsRect := ItemsRect;
Self.MenuBarItem := MenuBarItem;
Self.CloseButton := CloseButton;
Self.MaxButton := MaxButton;
Self.MinButton := MinButton;
Self.SysMenuButton := SysMenuButton;
Self.TrackMarkColor := TrackMarkColor;
Self.TrackMarkActiveColor := TrackMarkActiveColor;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
end;
end;
procedure TspSkinMainMenuBar.WMSize;
begin
inherited;
CalcRects;
end;
procedure TspSkinMainMenuBar.CreateMenu;
var
i, j: Integer;
MMIData: TspDataSkinMainMenuBarItem;
DS: TspDynamicSkinForm;
ChildMainMenu: TMainMenu;
begin
ClearObjects;
if (DSF <> nil) and (DSF.FForm.FormStyle = fsMDIForm)
then
ChildMainMenu := GetChildMainMenu
else
ChildMainMenu := nil;
if (FMainMenu = nil) then Exit;
if (FSD = nil) or (FSD.Empty)
then
MMIData := nil
else
begin
j := FSD.GetIndex(MenuBarItem);
if j <> -1
then MMIData := TspDataSkinMainMenuBarItem(FSD.ObjectList.Items[j])
else MMIData := nil;
end;
for i := 0 to FMainMenu.Items.Count - 1 do
if FMainMenu.Items[i].Visible
then
begin
ObjectList.Add(TspSkinMainMenuBarItem.Create(Self, MMIData));
with TspSkinMainMenuBarItem(ObjectList.Items[ObjectList.Count - 1]) do
begin
IDName := FMainMenu.Items[i].Name;
Enabled := FMainMenu.Items[i].Enabled;
MenuItem := FMainMenu.Items[i];
end;
end;
ChildMenuIn := ChildMainMenu <> nil;
if ChildMainMenu <> nil then
for i := 0 to ChildMainMenu.Items.Count - 1 do
if ChildMainMenu.Items[i].Visible
then
begin
ObjectList.Add(TspSkinMainMenuBarItem.Create(Self, MMIData));
with TspSkinMainMenuBarItem(ObjectList.Items[ObjectList.Count - 1]) do
begin
IDName := ChildMainMenu.Items[i].Name;
Enabled := ChildMainMenu.Items[i].Enabled;
MenuItem := ChildMainMenu.Items[i];
end;
end;
if Self.FMDIChildMax
then
begin
AddButtons;
DS := GetMDIChildDynamicSkinFormComponent;
if DS <> nil then CheckButtons(DS.BorderIcons);
end;
end;
procedure TspSkinMainMenuBar.SetMainMenu;
begin
FMainMenu := Value;
CreateMenu;
RePaint;
end;
procedure TspSkinMainMenuBar.UpDateItems;
begin
CreateMenu;
RePaint;
end;
procedure TspSkinMainMenuBar.ClearObjects;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
TspMenuBarObject(ObjectList.Items[i]).Free;
ObjectList.Clear;
ButtonsCount := 0;
end;
procedure TspSkinMainMenuBar.CMMouseEnter;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
MouseTimer.Enabled := True;
end;
procedure TspSkinMainMenuBar.CMMouseLeave;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
MouseTimer.Enabled := False;
TestActive(-1, -1);
end;
procedure TspSkinMainMenuBar.MouseDown;
begin
inherited;
TestActive(X, Y);
if (ActiveObject <> - 1)
then
with TspMenuBarObject(ObjectList.Items[ActiveObject]) do
begin
MouseCaptureObject := ActiveObject;
MouseDown(X, Y, Button);
if ssDouble in Shift then DblCLick;
end
else
if Scroll and FScrollMenu
then
begin
if PtInRect(GetMarkerRect, Point(X, Y)) then TrackScrollMenu;
end;
end;
procedure TspSkinMainMenuBar.MouseUp;
begin
if (MouseCaptureObject <> -1)
then
begin
TspMenuBarObject(ObjectList.Items[MouseCaptureObject]).MouseUp(X, Y, Button);
MouseCaptureObject := -1;
end;
inherited;
end;
procedure TspSkinMainMenuBar.MouseMove;
begin
if not MouseTimer.Enabled
then MouseTimer.Enabled := True;
inherited;
end;
procedure TspSkinMainMenuBar.BeforeChangeSkinData;
begin
FSkinSupport := False;
inherited;
ClearObjects;
end;
procedure TspSkinMainMenuBar.ChangeSkinData;
begin
GetSkinData;
FSkinSupport := FIndex <> -1;
CreateMenu;
if FSkinSupport
then
Height := RectHeight(SkinRect)
else
if FDefaultHeight > 0 then Height := FDefaultHeight;
RePaint;
end;
procedure TspSkinMainMenuBar.TestActive;
var
i: Integer;
B: Boolean;
begin
if ObjectList.Count = 0 then Exit;
OldActiveObject := ActiveObject;
i := -1;
B := False;
repeat
Inc(i);
with TspMenuBarObject(ObjectList.Items[i]) do
begin
if Enabled then B := PtInRect(ObjectRect, Point(X, Y));
end;
until B or (i = ObjectList.Count - 1);
if not B and (OldActiveObject <> -1) and MenuActive and
(TspMenuBarObject(ObjectList.Items[OldActiveObject]) is
TspSkinMainMenuBarItem)
then
ActiveObject := OldActiveObject
else
if B then ActiveObject := i else ActiveObject := -1;
if (MouseCaptureObject <> -1) and
(ActiveObject <> MouseCaptureObject) and (ActiveObject <> -1)
then
ActiveObject := -1;
if OldActiveObject >= ObjectList.Count then OldActiveObject := -1;
if ActiveObject >= ObjectList.Count then ActiveObject := -1;
if (OldActiveObject <> ActiveObject)
then
begin
if OldActiveObject <> - 1
then
if TspMenuBarObject(ObjectList.Items[OldActiveObject]).Enabled
then TspMenuBarObject(ObjectList.Items[OldActiveObject]).MouseLeave;
if ActiveObject <> -1
then
if TspMenuBarObject(ObjectList.Items[ActiveObject]).Enabled
then TspMenuBarObject(ObjectList.Items[ActiveObject]).MouseEnter;
end;
if Scroll and FScrollMenu
then
begin
if PtInRect(GetMarkerRect, Point(X, Y)) and not MarkerActive
then
begin
MarkerActive := True;
DrawMarker(Canvas);
end
else
if MarkerActive and not PtInRect(GetMarkerRect, Point(X, Y))
then
begin
MarkerActive := False;
DrawMarker(Canvas);
end;
end;
end;
procedure TspSkinMainMenuBar.TestMouse;
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (P.X >= 0) and (P.Y >= 0) and (P.X <= Width) and (P.Y <= Height)
then
TestActive(P.X, P.Y)
else
if MouseTimer.Enabled
then
begin
MouseTimer.Enabled := False;
TestActive(-1, -1);
end;
end;
procedure TspSkinMainMenuBar.TestMorph;
var
i: Integer;
StopMorph: Boolean;
begin
StopMorph := True;
for i := 0 to ObjectList.Count - 1 do
with TspMenuBarObject(ObjectList.Items[i]) do
begin
if Morphing and CanMorphing
then
begin
DoMorphing;
StopMorph := False;
end;
end;
if StopMorph
then
MorphTimer.Enabled := False;
end;
procedure TspSkinMainMenuBar.SetBounds;
begin
GetSkinData;
if FIndex <> -1 then AHeight := RectHeight(SkinRect);
inherited;
RePaint;
end;
procedure TspSkinMainMenuBar.PaintMenuBar(Cnvs: TCanvas);
var
Buffer: TBitMap;
R: TRect;
i: Integer;
begin
GetSkinData;
Buffer := TBitMap.Create;
R := Rect(0, 0, Width, Height);
if FIndex <> -1
then
begin
CreateHSkinImage(ItemsRect.Left, RectWidth(SkinRect) - ItemsRect.Right,
Buffer, Picture, SkinRect, Width, Height);
end
else
begin
Buffer.Width := Width;
Buffer.Height := Height;
with Buffer.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
CalcRects;
Scroll := False;
for i := 0 to ObjectList.Count - 1 do
with TspMenuBarObject(ObjectList.Items[i]) do
begin
if Visible then Draw(Buffer.Canvas);
end;
if Scroll and FScrollMenu then DrawMarker(Buffer.Canvas);
Cnvs.Draw(0, 0, Buffer);
Buffer.Free;
end;
procedure TspSkinMainMenuBar.Paint;
begin
end;
procedure TspSkinMainMenuBar.WMEraseBkgnd;
var
Cnvs: TCanvas;
begin
Cnvs := TCanvas.Create;
Cnvs.Handle := TWMEraseBkgnd(Message).DC;
PaintMenuBar(Cnvs);
Cnvs.Free;
Message.Result := 1;
end;
procedure TspSkinMainMenuBar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FMainMenu)
then FMainMenu := nil;
if (Operation = opRemove) and (AComponent = DSF)
then DSF := nil;
end;
//============= TspDynamicSkinForm =============//
type
TParentForm = class(TForm);
constructor TspDynamicSkinForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAlwaysShowInTray := False;
FLogoBitMap := TBitMap.Create;
FLogoBitMapTransparent := False;
FAlwaysMinimizeToTray := False;
FIcon := nil;
FShowIcon := False;
FSkinHint := nil;
FMaximizeOnFullScreen := False;
FSkinSupport := False;
FShowObjectHint := False;
FUseSkinCursors := False;
FDefCaptionFont := TFont.Create;
FDefInActiveCaptionFont := TFont.Create;
with FDefCaptionFont do
begin
Name := 'Arial';
Style := [fsBold];
Height := 14;
Color := clBtnText;
end;
with FDefInActiveCaptionFont do
begin
Name := 'Arial';
Style := [fsBold];
Height := 14;
Color := clBtnShadow;
end;
InMenu := False;
InMainMenu := False;
RMTop := TBitMap.Create;
RMLeft := TBitMap.Create;
RMBottom := TBitMap.Create;
RMRight := TBitMap.Create;
BlackColor := RGB(0, 0, 0);
ObjectList := TList.Create;
AreaList := TList.Create;
VisibleControls := TList.Create;
FSD := nil;
FMSD := nil;
FMainMenu := nil;
FSystemMenu := nil;
FInChangeSkinData := False;
MorphTimer := TTimer.Create(Self);
MorphTimer.Enabled := False;
MorphTimer.OnTimer := TestMorph;
MorphTimer.Interval := MorphTimerInterval;
MouseTimer := TTimer.Create(Self);
MouseTimer.Enabled := False;
MouseTimer.OnTimer := TestMouse;
MouseTimer.Interval := MouseTimerInterval;
AnimateTimer := TTimer.Create(Self);
AnimateTimer.Enabled := False;
AnimateTimer.OnTimer := TestAnimate;
AnimateTimer.Interval := AnimateTimerInterval;
OldBoundsRect := NulLRect;
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
MouseIn := False;
FMinWidth := 0;
FMinHeight := 0;
FRGN := 0;
FClientInstance := nil;
FPrevClientProc := nil;
FForm := TForm(Owner);
FForm.BorderIcons := [];
FForm.OnShortCut := FormShortCut;
FForm.AutoSize := False;
FForm.AutoScroll := False;
FSysMenu := TPopupMenu.Create(Self);
FUseDefaultSysMenu := True;
FSysTrayMenu := TspSkinPopupMenu.Create(Self);
FSysTrayMenu.ComponentForm := FForm;
CreateSysTrayMenu;
SkinMenu := TspSkinMenu.CreateEx(Self, FForm);
FMagneticSize := 10;
FBorderIcons := [biSystemMenu, biMinimize, biMaximize, biRollUp];
FAlphaBlend := False;
FAlphaBlendAnimation := False;
FAlphaBlendValue := 200;
FMenusAlphaBlend := False;
FMenusAlphaBlendValue := 200;
FMenusAlphaBlendAnimation := False;
FSupportNCArea := True;
FSizeAble := True;
FFullDrag := False;
FSizeMove := False;
FFormWidth := 0;
FFormHeight := 0;
FMainMenuBar := nil;
FMDITabsBar := nil;
FInShortCut := False;
if not (csDesigning in ComponentState)
then
begin
OldWindowProc := FForm.WindowProc;
FForm.WindowProc := NewWndProc;
TParentForm(FForm).ReCreateWnd;
SetWindowLong(FForm.Handle, GWL_STYLE,
GETWINDOWLONG(FForm.Handle, GWL_STYLE) and not WS_CAPTION);
end;
end;
destructor TspDynamicSkinForm.Destroy;
var
i: Integer;
begin
if not (csDesigning in ComponentState) and (FForm <> nil)
then
FForm.WindowProc := OldWindowProc;
FLogoBitMap.Free;
FDefCaptionFont.Free;
FDefInActiveCaptionFont.Free;
FSysMenu.Free;
FSysTrayMenu.Free;
ClearObjects;
MorphTimer.Free;
AnimateTimer.Free;
MouseTimer.Free;
ObjectList.Free;
AreaList.Free;
VisibleControls.Free;
SkinMenu.Free;
RMTop.Free;
RMLeft.Free;
RMBottom.Free;
RMRight.Free;
if FRgn <> 0 then DeleteObject(FRgn);
inherited Destroy;
end;
procedure TspDynamicSkinForm.CheckMDIBar;
var
DS: TspDynamicSkinForm;
begin
DS := GetDynamicSkinFormComponent(Application.MainForm);
if (DS <> nil) and (DS.MDITabsBar <> nil)
then
DS.MDITabsBar.CheckActive;
end;
procedure TspDynamicSkinForm.CheckMDIMainMenu;
var
DS: TspDynamicSkinForm;
begin
DS := GetDynamicSkinFormComponent(Application.MainForm);
if (DS <> nil) and (DS.MainMenuBar <> nil) and
((DS.MainMenuBar.GetChildMainMenu <> nil) or DS.MainMenuBar.ChildMenuIn)
then
DS.MainMenuBar.UpDateItems;
end;
procedure TspDynamicSkinForm.SetLogoBitMap;
begin
FLogoBitMap.Assign(Value);
end;
procedure TspDynamicSkinForm.DrawLogoBitMap(C: TCanvas);
var
X, Y: Integer;
begin
X := FForm.ClientWidth div 2 - FLogoBitMap.Width div 2;
Y := FForm.ClientHeight div 2 - FLogoBitMap.Height div 2;
if X < 0 then X := 0;
if Y < 0 then Y := 0;
if FLogoBitMap.Transparent <> FLogoBitmapTransparent
then
FLogoBitmap.Transparent := FLogoBitmapTransparent;
C.Draw(X, Y, FLogoBitMap);
end;
function TspDynamicSkinForm.GetUseSkinFontInMenu: Boolean;
begin
Result := SkinMenu.UseSkinFont;
end;
procedure TspDynamicSkinForm.SetUseSkinFontInMenu(Value: Boolean);
begin
SkinMenu.UseSkinFont := Value;
end;
procedure TspDynamicSkinForm.SetShowIcon(Value: Boolean);
begin
FShowIcon := Value;
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState)
then
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TspDynamicSkinForm.GetIcon;
var
IH: HICON;
IX, IY: Integer;
B: Boolean;
begin
if FIcon = nil
then
begin
FIcon := TIcon.Create;
B := False;
IH := 0;
if FForm.Icon.Handle <> 0
then
IH := FForm.Icon.Handle
else
if Application.Icon.Handle <> 0
then
IH := Application.Icon.Handle
else
begin
IH := LoadIcon(0, IDI_APPLICATION);
B := True;
end;
GetIconSize(IX, IY);
FIcon.Handle := CopyImage(IH, IMAGE_ICON, IX, IY, LR_COPYFROMRESOURCE);
if B then DestroyIcon(IH);
end;
end;
procedure TspDynamicSkinForm.DrawFormIcon(Cnvs: TCanvas; X, Y: Integer);
begin
GetIcon;
if FIcon <> nil then
DrawIconEx(Cnvs.Handle, X, Y, FIcon.Handle, 0, 0, 0, 0, DI_NORMAL);
end;
procedure TspDynamicSkinForm.GetIconSize(var X, Y: Integer);
begin
X := GetSystemMetrics(SM_CXSMICON);
if X = 0 then X := GetSystemMetrics(SM_CXSIZE);
Y := GetSystemMetrics(SM_CYSMICON);
if Y = 0 then Y := GetSystemMetrics(SM_CYSIZE);
end;
procedure TspDynamicSkinForm.MDIItemClick(Sender: TObject);
var
I: Integer;
S1, S2: String;
MainBSF, ChildBSF: TspDynamicSkinForm;
begin
MainBSF := GetDynamicSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
S1 := TMenuItem(Sender).Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
for I := 0 to MainBSF.FForm.MDIChildCount - 1 do
if MainBSF.FForm.MDIChildren[I].Name = S1
then
begin
ChildBSF := GetDynamicSkinFormComponent(MainBSF.FForm.MDIChildren[I]);
if (ChildBSF <> nil) and (ChildBSF.WindowState = wsMinimized)
then
ChildBSF.WindowState := wsNormal;
MainBSF.FForm.MDIChildren[I].Show;
end;
end;
procedure TspDynamicSkinForm.UpDateChildCaptionInMenu(Child: TCustomForm);
var
WM: TMenuItem;
MainBSF: TspDynamicSkinForm;
I: Integer;
S1, S2: String;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
S1 := WM.Items[I].Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
if Child.Name = S1
then
begin
WM.Items[I].Caption := Child.Caption;
Break;
end;
end;
end;
procedure TspDynamicSkinForm.UpDateChildActiveInMenu;
var
WM: TMenuItem;
MainBSF: TspDynamicSkinForm;
I: Integer;
S1, S2: String;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
S1 := WM.Items[I].Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
if MainBSF.FForm.ActiveMDIChild.Name = S1
then
WM.Items[I].Checked := True
else
WM.Items[I].Checked := False;
end;
end;
procedure TspDynamicSkinForm.AddChildToBar;
var
MainBSF: TspDynamicSkinForm;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if (MainBSF = nil) or (MainBSF.MDITabsBar = nil) then Exit;
MainBSF.MDITabsBar.AddTab(Child);
end;
procedure TspDynamicSkinForm.RefreshMDIBarTab(Child: TCustomForm);
var
MainBSF: TspDynamicSkinForm;
I: Integer;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if (MainBSF = nil) or (MainBSF.MDITabsBar = nil) then Exit;
with MainBSF.MDITabsBar do
for I := 0 to ObjectList.Count - 1 do
if TspMDITab(ObjectList.Items[I]).Child = Child
then
TspMDITab(ObjectList.Items[I]).Draw(MainBSF.MDITabsBar.Canvas);
end;
procedure TspDynamicSkinForm.AddChildToMenu;
var
WM: TMenuItem;
NewItem: TMenuItem;
MainBSF: TspDynamicSkinForm;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
NewItem := TMenuItem.Create(Self);
NewItem.Name := Child.Name + MI_CHILDITEM;
NewItem.Caption := Child.Caption;
NewItem.OnClick := MDIItemClick;
WM.Add(NewItem);
end;
procedure TspDynamicSkinForm.DeleteChildFromBar;
var
MainBSF: TspDynamicSkinForm;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if (MainBSF = nil) or (MainBSF.MDITabsBar = nil) then Exit;
MainBSF.MDITabsBar.DeleteTab(Child);
end;
procedure TspDynamicSkinForm.DeleteChildFromMenu;
var
WM, MI: TMenuItem;
MainBSF: TspDynamicSkinForm;
I: Integer;
S1, S2: String;
begin
MainBSF := DynamicSkinForm.GetDynamicSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
S1 := WM.Items[I].Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
if Child.Name = S1
then
begin
MI := WM.Items[I];
WM.Delete(I);
MI.Free;
Break;
end;
end;
if MainBSF.FForm.MDIChildCount = 0
then
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
MI := WM.Items[I];
WM.Delete(I);
MI.Free;
Break;
end;
end;
procedure TspDynamicSkinForm.SetAlphaBlend(Value: Boolean);
begin
if FAlphaBlend <> Value
then
begin
FAlphaBlend := Value;
if ComponentState = []
then
begin
if FAlphaBlend
then
begin
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetAlphaBlendTransparent(FForm.Handle, FAlphaBlendValue);
end
else
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;
end;
end;
procedure TspDynamicSkinForm.SetAlphaBlendValue(Value: Byte);
begin
if FAlphaBlendValue <> Value
then
begin
FAlphaBlendValue := Value;
if FAlphaBlend and (ComponentState = [])
then
SetAlphaBlendTransparent(FForm.Handle, FAlphaBlendValue);
end;
end;
procedure TspDynamicSkinForm.SetMenusAlphaBlend(Value: Boolean);
begin
FMenusAlphaBlend := Value;
if SkinMenu <> nil then SkinMenu.AlphaBlend := Value;
end;
procedure TspDynamicSkinForm.SetMenusAlphaBlendAnimation(Value: Boolean);
begin
FMenusAlphaBlendAnimation := Value;
if SkinMenu <> nil then SkinMenu.AlphaBlendAnimation := Value;
end;
procedure TspDynamicSkinForm.SetMenusAlphaBlendValue(Value: Byte);
begin
FMenusAlphaBlendValue := Value;
if SkinMenu <> nil then SkinMenu.AlphaBlendValue := Value;
end;
procedure TspDynamicSkinForm.TrackSystemMenu(X, Y: Integer);
var
MenuItem: TMenuItem;
begin
MenuItem := GetSystemMenu;
SkinMenuOpen;
if MenusSkinData = nil
then
SkinMenu.Popup(nil, SkinData, 0, Rect(X, Y, X, Y), MenuItem, False)
else
SkinMenu.Popup(nil, MenusSkinData, 0, Rect(X, Y, X, Y), MenuItem, False);
end;
function TspDynamicSkinForm.GetAutoRenderingInActiveImage: Boolean;
begin
if (FSD <> nil) and not (FSD.Empty)
then Result := FSD.AutoRenderingInActiveImage
else Result := False;
end;
procedure TspDynamicSkinForm.UpDateActiveObjects;
var
i: Integer;
begin
if ObjectList <> nil
then
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinAnimateObject
then
begin
with TspSkinAnimateObject(ObjectList.Items[i]) do
begin
FMouseIn := False;
Active := False;
FFrame := 1;
end;
end
else
if not (TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject)
then
with TspActiveSkinObject(ObjectList.Items[i]) do
begin
Active := False;
FMouseIn := False;
FMorphkf := 0;
end;
end;
function TspDynamicSkinForm.GetDefCaptionHeight: Integer;
begin
if (FForm.BorderStyle = bsToolWindow) or
(FForm.BorderStyle = bsSizeToolWin)
then
Result := DEFTOOLCAPTIONHEIGHT
else
Result := DEFCAPTIONHEIGHT;
end;
function TspDynamicSkinForm.GetDefButtonSize: Integer;
begin
if (FForm.BorderStyle = bsToolWindow) or
(FForm.BorderStyle = bsSizeToolWin)
then
Result := DEFTOOLBUTTONSIZE
else
Result := DEFBUTTONSIZE;
end;
function TspDynamicSkinForm.GetDefCaptionRect: TRect;
begin
CalcDefRects;
Result := NewDefCaptionRect;
end;
procedure TspDynamicSkinForm.ArangeMinimizedChilds;
var
I: Integer;
DS: TspDynamicSkinForm;
P: TPoint;
begin
for i := 0 to FForm.MDIChildCount - 1 do
begin
DS := GetDynamicSkinFormComponent(FForm.MDIChildren[i]);
if DS <> nil
then
begin
if DS.WindowState = wsMinimized
then
begin
P := DS.GetMinimizeCoord;
FForm.MDIChildren[i].Left := P.X;
FForm.MDIChildren[i].Top := P.Y;
end;
end;
end;
end;
procedure TspDynamicSkinForm.SetDefaultMenuItemHeight(Value: Integer);
begin
if Value > 0 then
SkinMenu.DefaultMenuItemHeight := Value;
end;
function TspDynamicSkinForm.GetDefaultMenuItemHeight: Integer;
begin
Result := SkinMenu.DefaultMenuItemHeight;
end;
procedure TspDynamicSkinForm.SetDefaultMenuItemFont(Value: TFont);
begin
SkinMenu.DefaultMenuItemFont.Assign(Value);
end;
function TspDynamicSkinForm.GetDefaultMenuItemFont: TFont;
begin
Result := SkinMenu.DefaultMenuItemFont;
end;
procedure TspDynamicSkinForm.SetBorderIcons;
begin
FBorderIcons := Value;
if FSupportNCArea or FSkinSupport
then
begin
LoadDefObjects;
CheckObjects;
end;
end;
procedure TspDynamicSkinForm.SetDefCaptionFont;
begin
FDefCaptionFont.Assign(Value);
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState) and not FSkinSupport
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TspDynamicSkinForm.SetDefInActiveCaptionFont;
begin
FDefInActiveCaptionFont.Assign(Value);
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState) and not FSkinSupport
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TspDynamicSkinForm.CorrectCaptionText;
var
j: Integer;
begin
j := Length(S);
with C do
begin
if TextWidth(S) > w
then
begin
repeat
Delete(S, j, 1);
Dec(j);
until (TextWidth(S + '...') <= w) or (S = '');
S := S + '...';
end;
end;
end;
procedure TspDynamicSkinForm.CalcDefRects;
var
i: Integer;
BSize: Integer;
OffsetX, OffsetY: Integer;
Button: TspSkinStdButtonObject;
procedure SetStdButtonRect(B: TspSkinStdButtonObject);
begin
if B <> nil
then
with B do
begin
ObjectRect := Rect(OffsetX - BSize, OffsetY, OffsetX, OffsetY + BSize);
OffsetX := OffsetX - BSize;
end;
end;
procedure SetStdButtonRect2(B: TspSkinStdButtonObject);
var
IX, IY: Integer;
begin
if B <> nil
then
with B do
begin
if (Command = cmSysMenu) and Parent.ShowIcon
then
begin
GetIconSize(IX, IY);
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + IX, OffsetY + IY);
OffsetX := OffsetX + IX;
end
else
begin
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + BSize, OffsetY + BSize);
OffsetX := OffsetX + BSize;
end;
end;
end;
function GetStdButton(C: TStdCommand): TspSkinStdButtonObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[I]) is TspSkinStdButtonObject
then
with TspSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TspSkinStdButtonObject(ObjectList.Items[I]);
Break;
end;
end;
begin
if (ObjectList = nil) or (ObjectList.Count = 0) then Exit;
i := 0;
OffsetX := FFormWidth - 3;
OffsetY := 4;
NewDefCaptionRect := Rect(3, 3, OffsetX, GetDefCaptionHeight);
BSize := GetDefButtonSize;
Button := GetStdButton(cmClose);
SetStdButtonRect(Button);
Button := GetStdButton(cmMaximize);
SetStdButtonRect(Button);
Button := GetStdButton(cmMinimize);
SetStdButtonRect(Button);
Button := GetStdButton(cmRollUp);
SetStdButtonRect(Button);
NewDefCaptionRect.Right := OffsetX;
OffsetX := NewDefCaptionRect.Left;
Button := GetStdButton(cmSysMenu);
if Button <> nil
then
begin
SetStdButtonRect2(Button);
NewDefCaptionRect.Left := OffsetX;
end;
end;
procedure TspDynamicSkinForm.PaintNCDefault;
var
PaintRect, R: TRect;
CB: TBitMap;
i: Integer;
TX, TY: Integer;
C: TColor;
LeftOffset, RightOffset: Integer;
S: String;
DC: HDC;
Cnvs: TControlCanvas;
F: TForm;
FA: Boolean;
begin
if FFormWidth = 0 then FFormWidth := FForm.Width;
if FFormHeight = 0 then FFormHeight := FForm.Height;
if (ObjectList.Count = 0) and not FSkinSupport then LoadDefObjects;
CalcDefRects;
DC := GetWindowDC(FForm.Handle);
Cnvs := TControlCanvas.Create;
Cnvs.Handle := DC;
CB := TBitMap.Create;
CB.Width := FFormWidth - 6;
CB.Height := GetDefCaptionHeight;
LeftOffset := NewDefCaptionRect.Left - 3;
RightOffset := CB.Width - NewDefCaptionRect.Right;
// create caption
with CB.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, CB.Width, CB.Height));
C := clBtnShadow;
for i := 2 to GetDefCaptionHeight - 4 do
begin
if C = clBtnShadow then C := clBtnHighLight else C := clBtnShadow;
Pen.Color := C;
MoveTo(LeftOffset + 2, i); LineTo(CB.Width - RightOffset - 6, i);
end;
FA := GetFormActive;
if FA
then
begin
CB.Canvas.Font.Assign(FDefCaptionFont);
Font := DefCaptionFont;
end
else
begin
CB.Canvas.Font.Assign(FDefInActiveCaptionFont);
Font := DefInActiveCaptionFont;
end;
// paint caption text
S := FForm.Caption;
if (FForm.FormStyle = fsMDIForm) and FMDIChildMaximized
then
begin
F := GetMaximizeMDIChild;
if F <> nil
then
S := S + ' - [' + F.Caption + ']';
end;
if S <> ''
then
begin
CorrectCaptionText(CB.Canvas, S, CB.Width - LeftOffset - RightOffset);
TX := LeftOffset + (CB.Width - LeftOffset - RightOffset) div 2 -
(TextWidth(S) + 5) div 2;
TY := GetDefCaptionHeight div 2 - TextHeight(S) div 2;
R := Rect(TX, 0, TX + TextWidth(S) + 5, CB.Height);
TextRect(R, TX + 3, TY, S);
end;
end;
if (ObjectList <> nil) and (ObjectList.Count > 0)
then
begin
for i := 0 to ObjectList.Count - 1 do
with TspActiveSkinObject(ObjectList.Items[i]) do
if Visible then
begin
OffsetRect(ObjectRect, -3, -3);
Draw(CB.Canvas, True);
OffsetRect(ObjectRect, 3, 3);
end;
end;
//paint border + caption
with Cnvs do
begin
ExcludeClipRect(Cnvs.Handle, 3, GetDefCaptionHeight + 3, FFormWidth - 3, FFormHeight - 3);
PaintRect := Rect(0, 0, FFormWidth, FFormHeight);
Draw(3, 3, CB);
Frame3D(Cnvs, PaintRect, cl3DLight, cl3DDKShadow, 1);
Frame3D(Cnvs, PaintRect, clBtnHighLight, clBtnShadow, 1);
Frame3D(Cnvs, PaintRect, clBtnFace, clBtnFace, 1);
CB.Free;
end;
Cnvs.Free;
ReleaseDC(FForm.Handle, DC);
end;
procedure TspDynamicSkinForm.PaintBGDefault;
var
C: TCanvas;
begin
C := TCanvas.Create;
C.Handle := DC;
with C do
begin
Brush.Color := clBtnFace;
FillRect(FForm.ClientRect);
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
end;
C.Free;
end;
procedure TspDynamicSkinForm.PaintMDIBGDefault(DC: HDC);
var
C: TCanvas;
begin
C := TCanvas.Create;
C.Handle := DC;
with C do
begin
Brush.Color := clAppWorkSpace;
FillRect(FForm.ClientRect);
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
end;
C.Free;
end;
procedure TspDynamicSkinForm.HookApp;
begin
OldAppMessage := Application.OnMessage;
Application.OnMessage := NewAppMessage;
end;
procedure TspDynamicSkinForm.UnHookApp;
begin
Application.OnMessage := OldAppMessage;
end;
function TspDynamicSkinForm.GetMaximizeMDIChild: TForm;
var
i: Integer;
DS: TspDynamicSkinForm;
begin
Result := nil;
DS := nil;
if Application.MainForm.ActiveMDIChild <> nil
then
DS := GetDynamicSkinFormComponent(Application.MainForm.ActiveMDIChild);
if (DS <> nil) and (DS.WindowState = wsMaximized)
then
Result := Application.MainForm.ActiveMDIChild
else
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
DS := GetDynamicSkinFormComponent(Application.MainForm.MDIChildren[i]);
if (DS <> nil) and (DS.WindowState = wsMaximized)
then
begin
Result := Application.MainForm.MDIChildren[i];
Break;
end;
end;
end;
function TspDynamicSkinForm.IsMDIChildMaximized;
begin
Result := FMDIChildMaximized;
end;
procedure TspDynamicSkinForm.Tile;
var
ColumnCount: Integer;
FInColumnCount: Integer;
R: TRect;
W, H: Integer;
i, j, X, Y, FW, FH, L, T: Integer;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
RestoreAll;
ColumnCount := Trunc(Sqrt(FForm.MDIChildCount));
if ColumnCount <= 0 then Exit;
FInColumnCount := FForm.MDIChildCount div ColumnCount;
if FInColumnCount * ColumnCount < FForm.MDIChildCount
then Inc(FInColumnCount, 1);
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
FW := W div ColumnCount;
FH := H div FInColumnCount;
X := W;
Y := H;
j := ColumnCount;
for i := FForm.MDIChildCount downto 1 do
begin
L := X - FW;
T := Y - FH;
if L < 0 then L := 0;
if T < 0 then T := 0;
FForm.MDIChildren[i - 1].SetBounds(L, T, FW, FH);
Y := Y - FH;
if (Y - FH < 0) and (i <> 0)
then
begin
Y := H;
X := X - FW;
Dec(j);
if j = 0 then j := 1;
FInColumnCount := (i - 1) div j;
if FInColumnCount * j < (i - 1)
then Inc(FInColumnCount, 1);
if FInColumnCount = 0
then FInColumnCount := 1;
FH := H div FInColumnCount;
end;
end;
end;
procedure TspDynamicSkinForm.Cascade;
var
i, j, k, FW, FH, FW1, FH1, W, H, Offset1, Offset2: Integer;
R: TRect;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
RestoreAll;
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
if FSkinSupport
then
Offset1 := NewClRect.Top
else
Offset1 := GetDefCaptionHeight + 3;
Offset2 := W - Round(W * 0.8);
j := Offset2 div Offset1;
if FForm.MDIChildCount < j
then
begin
FW := W - (FForm.MDIChildCount - 1) * Offset1;
FH := H - (FForm.MDIChildCount - 1) * Offset1;
end
else
begin
FW := W - j * Offset1;
FH := H - j * Offset1;
end;
if FW < GetMinWidth then FW := GetMinWidth;
if FH < GetMinHeight then FH := GetMinHeight;
k := 0;
for i := FForm.MDIChildCount - 1 downto 0 do
begin
FW1 := FW;
FH1 := FH;
if (FForm.MDIChildren[i].BorderStyle = bsSingle)
then
begin
FW1 := FForm.MDIChildren[i].Width;
FH1 := FForm.MDIChildren[i].Height;
end;
if (k + FW1 > W) or (k + FH1 > H) then k := 0;
FForm.MDIChildren[i].SetBounds(k, k, FW1, FH1);
k := k + Offset1;
end;
end;
procedure TspDynamicSkinForm.MinimizeAll;
var
i: Integer;
DS: TspDynamicSkinForm;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
for i := 0 to FForm.MDIChildCount - 1 do
begin
DS := GetDynamicSkinFormComponent(FForm.MDIChildren[i]);
if DS <> nil then DS.WindowState := wsMinimized;
end;
end;
procedure TspDynamicSkinForm.MaximizeAll;
var
i: Integer;
DS: TspDynamicSkinForm;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
for i := 0 to FForm.MDIChildCount - 1 do
begin
DS := GetDynamicSkinFormComponent(FForm.MDIChildren[i]);
if DS <> nil then DS.WindowState := wsMaximized;
end;
end;
procedure TspDynamicSkinForm.CloseAll;
var
i: Integer;
begin
if FForm.FormStyle = fsMDIForm
then
for i := FForm.MDIChildCount - 1 downto 0 do
FForm.MDIChildren[i].Close;
end;
procedure TspDynamicSkinForm.RestoreAll;
var
i: Integer;
DS: TspDynamicSkinForm;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
for i := 0 to FForm.MDIChildCount - 1 do
begin
DS := GetDynamicSkinFormComponent(FForm.MDIChildren[i]);
if (DS <> nil) and (DS.WindowState <> wsNormal) then DS.WindowState := wsNormal;
if DS.RollUpState and (DS.WindowState = wsNormal) then DS.RollUpState := False;
end;
end;
procedure TspDynamicSkinForm.ResizeMDIChilds;
var
i: Integer;
begin
for i := 0 to FForm.MDIChildCount - 1 do
SendMessage(FForm.MDIChildren[i].Handle, WM_MDICHANGESIZE, 0, 0);
ArangeMinimizedChilds;
end;
function TspDynamicSkinForm.GetMDIWorkArea;
function GetTop: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := 0;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alTop) and
(Controls[i].Top + Controls[i].Height > j)
then
j := Controls[i].Top + Controls[i].Height;
end;
Result := j;
end;
function GetBottom: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := ClientHeight;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alBottom) and
(Controls[i].Top < j)
then
j := Controls[i].Top;
end;
Result := j;
end;
function GetLeft: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := 0;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alLeft) and
(Controls[i].Left + Controls[i].Width > j)
then
j := Controls[i].Left + Controls[i].Width;
end;
Result := j;
end;
function GetRight: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := ClientWidth;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alRight) and
(Controls[i].Left < j)
then
j := Controls[i].Left;
end;
Result := j;
end;
begin
if Application.MainForm <> nil then
Result := Rect(GetLeft, GetTop, GetRight, GetBottom);
end;
procedure TspDynamicSkinForm.TrayIconDBLCLK;
begin
RestoreFromTray;
end;
procedure TspDynamicSkinForm.MinimizeToTray;
begin
if FTrayIcon <> nil
then
with FTrayIcon do
begin
FTrayIcon.MinimizeToTray := True;
Application.Minimize;
if Assigned(FOnMinimizeToTray) then FOnMinimizeToTray(Self);
end;
end;
procedure TspDynamicSkinForm.RestoreFromTray;
begin
if FTrayIcon <> nil
then
with FTrayIcon do
begin
FTrayIcon.MinimizeToTray := False;
FTrayIcon.ShowMainForm;
Application.Restore;
if not FAlwaysShowInTray then FTrayIcon.IconVisible := False;
if Assigned(FOnRestoreFromTray) then FOnRestoreFromTray(Self);
end;
end;
procedure TspDynamicSkinForm.SetTrayIcon;
begin
FTrayIcon := Value;
if TrayIcon <> nil
then
with TrayIcon do
begin
if not FAlwaysShowInTray then IconVisible := False;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
Self.BorderIcons := Self.BorderIcons + [biMinimizeToTray];
if not (csDesigning in ComponentState)
then
begin
if PopupMenu = nil
then
begin
PopupMenu := FSysTrayMenu;
OnDblClick := TrayIconDBLCLK;
end;
end;
end
else
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
Self.BorderIcons := Self.BorderIcons - [biMinimizeToTray];
end;
procedure TspDynamicSkinForm.TSM_Restore(Sender: TObject);
begin
RestoreFromTray;
end;
procedure TspDynamicSkinForm.TSM_Close(Sender: TObject);
begin
FForm.Close;
end;
procedure TspDynamicSkinForm.SM_Restore(Sender: TObject);
begin
if MaxRollUpState or (FRollUpState and (WindowState = wsNormal))
then
RollUpState := False
else
WindowState := wsNormal;
end;
procedure TspDynamicSkinForm.SM_Max(Sender: TObject);
begin
WindowState := wsMaximized;
end;
procedure TspDynamicSkinForm.SM_Min(Sender: TObject);
begin
if FAlwaysMinimizeToTray
then
MinimizeToTray
else
WindowState := wsMinimized;
end;
procedure TspDynamicSkinForm.SM_RollUp(Sender: TObject);
begin
RollUpState := True;
end;
procedure TspDynamicSkinForm.SM_Close(Sender: TObject);
begin
FForm.Close;
end;
procedure TspDynamicSkinForm.SM_MinToTray(Sender: TObject);
begin
MinimizeToTray;
end;
procedure TspDynamicSkinForm.CreateUserSysMenu;
procedure AddMaxItem;
var
MI: TMenuItem;
begin
if not (biMaximize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MAXName;
Caption := SP_MI_MAXCAPTION;
OnClick := SM_Max;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddMinItem;
var
MI: TMenuItem;
begin
if not (biMinimize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINName;
Caption := SP_MI_MINCAPTION;
OnClick := SM_Min;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddRestoreItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_RESTOREName;
Caption := SP_MI_RESTORECAPTION;
OnClick := SM_Restore;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddRollUpItem;
var
MI: TMenuItem;
begin
if not (biRollUp in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_ROLLUPName;
Caption := SP_MI_ROLLUPCAPTION;
OnClick := SM_RollUp;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddCloseItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_CLOSEName;
Caption := SP_MI_CLOSECAPTION;
OnClick := SM_Close;
if FForm.FormStyle = fsMDIChild
then
ShortCut := TextToShortCut('Ctrl+F4')
else
ShortCut := TextToShortCut('Alt+F4');
end;
FSystemMenu.Items.Add(MI);
end;
procedure AddMinToTrayItem;
var
MI: TMenuItem;
begin
if not (biMinimizeToTray in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINTOTRAYName;
Caption := SP_MI_MINTOTRAYCAPTION;
OnClick := SM_MinToTray;
end;
FSystemMenu.Items.Insert(0, MI);
end;
var
B: Boolean;
i: Integer;
begin
if not FUseDefaultSysMenu then Exit;
// delete old items
repeat
B := True;
for i := 0 to FSystemMenu.Items.Count - 1 do
if (FSystemMenu.Items[i].Name = MI_MINName) or
(FSystemMenu.Items[i].Name = MI_MAXName) or
(FSystemMenu.Items[i].Name = MI_CLOSEName) or
(FSystemMenu.Items[i].Name = MI_MINTOTRAYName) or
(FSystemMenu.Items[i].Name = MI_ROLLUPName) or
(FSystemMenu.Items[i].Name = MI_RESTOREName)
then
begin
FSystemMenu.Items[i].Free;
B := False;
Break;
end;
until B;
//
AddMinToTrayItem;
if not ((FForm.FormStyle = fsMDIChild) and (FWindowState = wsMaximized))
then
if not FRollUpState and (FWindowState <> wsMinimized)
then AddRollUpItem;
if FWindowState <> wsMaximized then AddMaxItem;
if (FWindowState <> wsNormal) or FRollUpState then AddRestoreItem;
if FWindowState <> wsMinimized then AddMinItem;
AddCloseItem;
end;
function TspDynamicSkinForm.GetSystemMenu;
begin
if FSystemMenu <> nil
then
begin
CreateUserSysMenu;
Result := FSystemMenu.Items;
end
else
begin
CreateSysMenu;
Result := FSysMenu.Items;
end;
end;
procedure TspDynamicSkinForm.CreateSysTrayMenu;
procedure AddRestoreItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := TMI_RESTOREName;
Caption := SP_MI_RESTORECAPTION;
OnClick := TSM_Restore;
end;
FSysTrayMenu.Items.Add(MI);
end;
procedure AddCloseItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := TMI_CLOSEName;
Caption := SP_MI_CLOSECAPTION;
OnClick := TSM_Close;
if FForm.FormStyle = fsMDIChild
then
ShortCut := TextToShortCut('Ctrl+F4')
else
ShortCut := TextToShortCut('Alt+F4');
end;
FSysTrayMenu.Items.Add(MI);
end;
procedure AddDevItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
MI.Caption := '-';
FSysTrayMenu.Items.Add(MI);
end;
begin
AddRestoreItem;
AddDevItem;
AddCloseItem;
end;
procedure TspDynamicSkinForm.CreateSysMenu;
procedure AddMaxItem;
var
MI: TMenuItem;
begin
if not (biMaximize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MAXName;
Caption := SP_MI_MAXCAPTION;
OnClick := SM_Max;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddMinItem;
var
MI: TMenuItem;
begin
if not (biMinimize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINName;
Caption := SP_MI_MINCAPTION;
OnClick := SM_Min;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddRestoreItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_RESTOREName;
Caption := SP_MI_RESTORECAPTION;
OnClick := SM_Restore;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddRollUpItem;
var
MI: TMenuItem;
begin
if not (biRollUp in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_ROLLUPName;
Caption := SP_MI_ROLLUPCAPTION;
OnClick := SM_RollUp;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddCloseItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_CLOSEName;
Caption := SP_MI_CLOSECAPTION;
OnClick := SM_Close;
if FForm.FormStyle = fsMDIChild
then
ShortCut := TextToShortCut('Ctrl+F4')
else
ShortCut := TextToShortCut('Alt+F4');
end;
FSysMenu.Items.Add(MI);
end;
procedure AddMinToTrayItem;
var
MI: TMenuItem;
begin
if not (biMinimizeToTray in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINTOTRAYName;
Caption := SP_MI_MINTOTRAYCAPTION;
OnClick := SM_MinToTray;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddDevItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
MI.Caption := '-';
FSysMenu.Items.Add(MI);
end;
var
i: Integer;
begin
for i := FSysMenu.Items.Count - 1 downto 0 do
TMenuItem(FSysMenu.Items[i]).Free;
if FWindowState <> wsMinimized then AddMinItem;
if FWindowState <> wsMaximized then AddMaxItem;
if (FWindowState <> wsNormal) or FRollUpState then AddRestoreItem;
if not ((FForm.FormStyle = fsMDIChild) and (FWindowState = wsMaximized))
then
if not FRollUpState and (FWindowState <> wsMinimized)
then AddRollUpItem;
AddMinToTrayItem;
if FSysMenu.Items.Count > 0 then AddDevItem;
AddCloseItem;
end;
function TspDynamicSkinForm.CanNCSupport: Boolean;
begin
Result := FSupportNCArea and (FSD <> nil) and not FSD.Empty and
not IsNullRect(FSD.ClRect);
end;
function TspDynamicSkinForm.GetFullDragg: Boolean;
var
B: Boolean;
begin
SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @B, 0);
Result := B;
end;
function TspDynamicSkinForm.GetMinimizeCoord;
function GetMDIEqualCoord(P: TPoint): Boolean;
var
DS: TspDynamicSkinForm;
MF: TForm;
i: Integer;
begin
Result := True;
MF := Application.MainForm;
for i := 0 to MF.MDIChildCount - 1 do
if (MF.MDIChildren[i] <> FForm) and MF.MDIChildren[i].Visible
then
begin
DS := GetDynamicSkinFormComponent(MF.MDIChildren[i]);
if (DS <> nil) and (DS.WindowState = wsMinimized) and
(MF.MDIChildren[i].Left = P.X) and (MF.MDIChildren[i].Top = P.Y)
then
begin
Result := False;
Break;
end;
end;
end;
function GetSDIEqualCoord(P: TPoint): Boolean;
var
DS: TspDynamicSkinForm;
i: Integer;
begin
Result := True;
for i := 0 to Screen.FormCount - 1 do
if (Screen.Forms[i] <> FForm) and (Screen.Forms[i] <> Application.MainForm) and
(Screen.Forms[i].Visible)
then
begin
DS := GetDynamicSkinFormComponent(Screen.Forms[i]);
if (DS <> nil) and (DS.WindowState = wsMinimized) and
(Screen.Forms[i].Left = P.X) and (Screen.Forms[i].Top = P.Y)
then
begin
Result := False;
Break;
end;
end;
end;
var
R: TRect;
P: TPoint;
MW, MH, W, H: Integer;
B: Boolean;
begin
P := Point(0, 0);
MW := GetMinWidth;
MH := GetMinHeight;
if FForm.FormStyle = fsMDIChild
then
begin
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
P.Y := H - MH;
P.X := 0;
repeat
B := GetMDIEqualCoord(P);
if not B
then
begin
P.X := P.X + MW;
if P.X + MW > W
then
begin
P.X := 0;
P.Y := P.Y - MH;
if P.Y < 0
then
begin
P.Y := H - MH;
B := True;
end;
end;
end;
until B;
end
else
begin
R := GetMonitorWorkArea(FForm.Handle, True);
P.Y := R.Bottom - MH;
P.X := R.Left;
repeat
B := GetSDIEqualCoord(P);
if not B
then
begin
P.X := P.X + MW;
if P.X + MW > R.Bottom
then
begin
P.X := R.Left;
P.Y := P.Y - MH;
if P.Y < R.Top
then
begin
P.Y := R.Bottom - MH;
B := True;
end;
end;
end;
until B;
end;
Result := P;
end;
function TspDynamicSkinForm.CanObjectTest;
begin
if FSupportNCArea
then
Result := not ARollUp
else
Result := (FRollUpState and ARollUp) or (not FRollUpState and not ARollUp);
end;
procedure TspDynamicSkinForm.SetSupportNCArea;
begin
FSupportNCArea := Value;
if FForm <> nil then
if not FSupportNCArea and (csDesigning in ComponentState)
then FForm.BorderStyle := bsNone;
end;
function TspDynamicSkinForm.GetMinWidth: Integer;
begin
if FSupportNCArea
then
begin
if FSkinSupport
then
begin
if (FMinWidth > FSD.FPicture.Width) and
not (FWindowState = wsMinimized)
then Result := FMinWidth
else Result := FSD.FPicture.Width;
end
else
begin
if FMinWidth > 0
then Result := FMinWidth
else Result := DEFFORMMINWIDTH;
end;
end
else
begin
if FSkinSupport
then
begin
if FMinWidth = 0
then
Result := FSD.FPicture.Width
else
if FSkinSupport and (FMinWidth > FSD.FPicture.Width)
then Result := FSD.FPicture.Width
else Result := FMinWidth;
end
else
Result := 0;
end;
end;
function TspDynamicSkinForm.GetMinHeight: Integer;
begin
if FSupportNCArea
then
begin
if FSkinSupport
then
begin
if (FMinHeight > FSD.FPicture.Height - RectHeight(FSD.ClRect))
and not FRollUpState
and not (FWindowState = wsMinimized)
then Result := FMinHeight
else Result := FSD.FPicture.Height - RectHeight(FSD.ClRect);
end
else
begin
if (FMinHeight > GetDefCaptionHeight + 6)
and not FRollUpState
and not (FWindowState = wsMinimized)
then Result := FMinHeight
else Result := GetDefCaptionHeight + 6;
end;
end
else
begin
if FSkinSupport
then
begin
if (FMinHeight = 0)
then
Result := FSD.FPicture.Height
else
if (FMinHeight > FSD.FPicture.Height)
then Result := FSD.FPicture.Height
else Result := FMinHeight;
end
else
Result := 0;
end;
end;
function TspDynamicSkinForm.GetMaxWidth: Integer;
var
R: TRect;
begin
R := GetMonitorWorkArea(FForm.Handle, not FMaximizeOnFullScreen);
Result := RectWidth(R);
end;
function TspDynamicSkinForm.GetMaxHeight: Integer;
var
R: TRect;
begin
R := GetMonitorWorkArea(FForm.Handle, not FMaximizeOnFullScreen);
Result := RectHeight(R);
end;
procedure TspDynamicSkinForm.DrawSkinObject;
var
DC: HDC;
Cnvs: TControlCanvas;
begin
if CanObjectTest(AObject.RollUp) then
if SupportNCArea
then
begin
if not(((WindowState = wsMaximized) and (FForm.FormStyle = fsMDIChild))
or (FForm.BorderStyle = bsNone))
then
begin
DC := GetWindowDC(FForm.Handle);
Cnvs := TControlCanvas.Create;
Cnvs.Handle := DC;
//
AObject.Draw(Cnvs, True);
//
Cnvs.Handle := 0;
ReleaseDC(FForm.Handle, DC);
Cnvs.Free;
end;
end
else
AObject.Draw(FForm.Canvas, True);
end;
procedure TspDynamicSkinForm.PointToNCPoint(var P: TPoint);
begin
if FForm.FormStyle = fsMDIChild
then
begin
P := FForm.ScreenToClient(P);
if FSkinSupport
then
begin
P.X := P.X + NewClRect.Left;
P.Y := P.Y + NewClRect.Top;
end
else
begin
P.X := P.X + 3;
P.Y := P.Y + GetDefCaptionHeight + 3;
end;
end
else
begin
P.X := P.X - FForm.Left;
P.Y := P.Y - FForm.Top;
end;
end;
procedure TspDynamicSkinForm.PaintNCSkin;
var
CaptionBitMap, LeftBitMap, RightBitMap, BottomBitMap: TBitMap;
DC: HDC;
Cnvs: TCanvas;
TempRect: TRect;
i: Integer;
CEB, LEB, REB, BEB: TspEffectBmp;
begin
if not CanNCSupport then Exit;
if FFormWidth = 0 then FFormWidth := FForm.Width;
if FFormheight = 0 then FFormHeight := FForm.Height;
if (FFormWidth < GetMinWidth) or (FFormHeight < GetMinHeight) then Exit;
CalcRects;
CalcAllRealObjectRect;
DC := GetWindowDC(FForm.Handle);
Cnvs := TCanvas.Create;
Cnvs.Handle := DC;
CaptionBitMap := TBitMap.Create;
LeftBitMap := TBitMap.Create;
RightBitMap := TBitMap.Create;
BottomBitMap := TBitMap.Create;
// crate borderbitmap
with FSD do
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, ClRect,
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftBitMap, CaptionBitMap, RightBitMap, BottomBitMap,
FPicture, Rect(0, 0, FPicture.Width, FPicture.Height),
FFormWidth, FFormHeight,
LeftStretch, TopStretch, RightStretch, BottomStretch);
// draw mainmenuitems
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(ObjectList.Items[i]) do
begin
if NewMainMenuRect.Top <= NewClRect.Top
then
Draw(CaptionBitMap.Canvas, False)
else
Draw(BottomBitMap.Canvas, False);
end;
// draw skin objects
for i := 0 to ObjectList.Count - 1 do
with TspActiveSkinObject(ObjectList.Items[i]) do
if CanObjectTest(RollUp) and
not (TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem)
then
if Visible then
begin
if (ObjectRect.Bottom <= NewClRect.Top)
then
Draw(CaptionBitMap.Canvas, False)
else
begin
TempRect := ObjectRect;
OffsetRect(ObjectRect, 0, -NewClRect.Bottom);
Draw(BottomBitMap.Canvas, False);
ObjectRect := TempRect;
end;
end;
//
if NewClRect.Bottom > NewClRect.Top
then
ExcludeClipRect(Cnvs.Handle,
NewClRect.Left, NewClRect.Top, NewClRect.Right, NewClRect.Bottom);
// paint nc
if GetFormActive or not GetAutoRenderingInActiveImage
then
begin
Cnvs.Draw(0, 0, CaptionBitMap);
Cnvs.Draw(0, CaptionBitMap.Height, LeftBitMap);
Cnvs.Draw(FFormWidth - RightBitMap.Width, CaptionBitMap.Height, RightBitMap);
Cnvs.Draw(0, FFormHeight - BottomBitMap.Height, BottomBitMap);
end
else
begin
CEB := TspEffectBmp.CreateFromhWnd(CaptionBitMap.Handle);
LEB := TspEffectBmp.CreateFromhWnd(LeftBitMap.Handle);
REB := TspEffectBmp.CreateFromhWnd(RightBitMap.Handle);
BEB := TspEffectBmp.CreateFromhWnd(BottomBitMap.Handle);
case FSD.InActiveEffect of
ieBrightness:
begin
CEB.ChangeBrightness(InActiveBrightnessKf);
LEB.ChangeBrightness(InActiveBrightnessKf);
REB.ChangeBrightness(InActiveBrightnessKf);
BEB.ChangeBrightness(InActiveBrightnessKf);
end;
ieDarkness:
begin
CEB.ChangeDarkness(InActiveDarknessKf);
LEB.ChangeDarkness(InActiveDarknessKf);
REB.ChangeDarkness(InActiveDarknessKf);
BEB.ChangeDarkness(InActiveDarknessKf);
end;
ieGrayScale:
begin
CEB.GrayScale;
LEB.GrayScale;
REB.GrayScale;
BEB.GrayScale;
end;
ieNoise:
begin
CEB.AddMonoNoise(InActiveNoiseAmount);
LEB.AddMonoNoise(InActiveNoiseAmount);
REB.AddMonoNoise(InActiveNoiseAmount);
BEB.AddMonoNoise(InActiveNoiseAmount);
end;
ieSplitBlur:
begin
CEB.SplitBlur(1);
LEB.SplitBlur(1);
REB.SplitBlur(1);
BEB.SplitBlur(1);
end;
ieInvert:
begin
CEB.Invert;
LEB.Invert;
REB.Invert;
BEB.Invert;
end;
end;
CEB.Draw(Cnvs.Handle, 0, 0);
LEB.Draw(Cnvs.Handle, 0, CaptionBitMap.Height);
REB.Draw(Cnvs.Handle, FFormWidth - RightBitMap.Width, CaptionBitMap.Height);
BEB.Draw(Cnvs.Handle, 0, FFormHeight - BottomBitMap.Height);
CEB.Free;
LEB.Free;
REB.Free;
BEB.Free;
end;
//
BottomBitMap.Free;
RightBitMap.Free;
LeftBitMap.Free;
CaptionBitMap.Free;
ReleaseDC(FForm.Handle, DC);
Cnvs.Handle := 0;
Cnvs.Free;
end;
procedure TspDynamicSkinForm.FormShortCut;
var
MM: TMainMenu;
begin
if FInShortCut
then
begin
FInShortCut := False;
Handled := False;
Exit;
end;
if (FMainMenuBar <> nil) and (FMainMenuBar.MainMenu <> nil)
then
MM := FMainMenuBar.MainMenu
else
MM := FMainMenu;
if MM <> nil
then
if (KeyDataToShiftState(Msg.KeyData) = [ssAlt]) and FindHotKeyItem(Msg.CharCode)
then
Handled := True
else
begin
FInShortCut := MM.IsShortCut(Msg);
if FInShortCut then Handled := True else Handled := False;
end;
end;
procedure TspDynamicSkinForm.SetDefaultCaptionText(AValue: String);
var
i: Integer;
begin
if (FSD <> nil) and (not FSD.Empty)
then
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject
then
with TspSkinCaptionObject(ObjectList.Items[i]) do
begin
if DefaultCaption
then TextValue := FForm.Caption;
end
end;
procedure TspDynamicSkinForm.SetFormStyle;
begin
if (FS = fsNormal) or (FS = fsStayOnTop)
then
begin
FForm.FormStyle := FS;
if FAlphaBlend then UpDateSkinControls(0, FForm);
end;
end;
procedure TspDynamicSkinForm.SetRollUpFormRegion;
var
RMask: TBitMap;
Size: Integer;
RgnData: PRgnData;
TempRgn: HRGN;
begin
if (FSD.FRollUpMask.Empty) and (FRgn = 0) then Exit;
if (FSD.FRollUpMask.Empty) and (FRgn <> 0)
then
begin
SetWindowRgn(FForm.Handle, 0, True);
DeleteObject(FRgn);
FRgn := 0;
end
else
if (not FSD.FRollUpMask.Empty)
then
begin
if FSD.RollUpRightPoint.X > FSD.RollUpLeftPoint.X
then
begin
RMask := TBitMap.Create;
with FSD do
CreateHSkinImage(
RollUpLeftPoint.X, FRollUpMask.Width - RollUpRightPoint.X,
RMask, FRollUpMask,
Rect(0, 0, FRollUpMask.Width, FRollUpMask.Height),
FForm.Width, FRollUpMask.Height);
Size := CreateRgnFromBmp(RMask, 0, 0, RgnData);
RMask.Free;
end
else
Size := CreateRgnFromBmp(FSD.FRollUpMask, 0, 0, RgnData);
if Size <> 0
then
begin
TempRgn := FRgn;
FRgn := ExtCreateRegion(nil, Size, RgnData^);
SetWindowRgn(FForm.Handle, FRgn, True);
if TempRgn <> 0 then DeleteObject(TempRgn);
FreeMem(RgnData, Size);
end;
end;
end;
procedure TspDynamicSkinForm.CreateRollUpForm2;
begin
FForm.Height := GetMinHeight;
end;
procedure TspDynamicSkinForm.CreateRollUpForm;
var
W, H, dx: Integer;
procedure CalcRollUpObjectsRects;
function CalcRollUpObjectRect(R: TRect): TRect;
begin
if R.Left >= FSD.RollUpRightPoint.X
then
OffsetRect(R, dx, 0)
else
if (R.Left <= FSD.RollUpLeftPoint.X) and
(R.Right >= FSD.RollUpRightPoint.X)
then
Inc(R.Right, dx);
Result := R;
end;
var
i: Integer;
begin
if (FSD.RollUpRightPoint.X > FSD.RollUpLeftPoint.X)
then
for i := 0 to ObjectList.Count - 1 do
with TspActiveSkinObject(ObjectList.Items[i]) do
begin
if RollUp
then
ObjectRect := CalcRollUpObjectRect(SkinRect);
end;
end;
procedure HideControls;
var
i: Integer;
begin
VisibleControls.Clear;
for i := 0 to FForm.ControlCount - 1 do
begin
if FForm.Controls[i].Visible
then
begin
VisibleControls.Add(FForm.Controls[i]);
FForm.Controls[i].Visible := False;
end;
end;
end;
begin
H := FSD.FRollUpPicture.Height;
if FSD.RollUpLeftPoint.X >= FSD.RollUpRightPoint.X
then
begin
W := FSD.FRollUpPicture.Width;
dx := 0;
end
else
begin
W := FForm.Width;
dx := W - FSD.FRollUpPicture.Width;
end;
CalcRollUpObjectsRects;
TestActive(-1, -1, True);
MouseTimer.Enabled := False;
MorphTimer.Enabled := False;
//
if VisibleControls.Count = 0 then HideControls;
if FSD.RollUpLeftPoint.X >= FSD.RollUpRightPoint.X
then
FForm.SetBounds(FForm.Left, FForm.Top, W, H)
else
FForm.Height := H;
SetRollUpFormRegion;
if FSupportNCArea
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0)
else FForm.RePaint;
MouseTimer.Enabled := True;
MorphTimer.Enabled := True;
end;
procedure TspDynamicSkinForm.RestoreRollUpForm2;
begin
FForm.Height := OldHeight;
end;
procedure TspDynamicSkinForm.RestoreRollUpForm;
procedure ShowControls;
var
i: Integer;
begin
for i := 0 to VisibleControls.Count - 1 do
TControl(VisibleControls.Items[i]).Visible := True;
VisibleControls.Clear;
end;
begin
TestActive(-1, -1, True);
MouseTimer.Enabled := False;
MorphTimer.Enabled := False;
//
ShowControls;
if CanScale
then
FForm.Height := OldHeight;
CheckSize;
//
MouseTimer.Enabled := True;
MorphTimer.Enabled := True;
end;
procedure TspDynamicSkinForm.SetRollUpState;
begin
if (not FSkinSupport and not FSupportNCArea) or not (biRollUp in FBorderIcons) or
(FRollUpState and (FWindowState = wsMaximized) and not MaxRollUpState) or
(FWindowState = wsMinimized)
then Exit;
if WindowState = wsMaximized then MaxRollUpState := Value;
FRollUpState := Value;
if FSupportNCArea
then
begin
if FRollUpState
then
begin
OldHeight := FForm.Height;
CreateRollUpForm2;
end
else
RestoreRollUpForm2;
end
else
if not FSD.FRollUpPicture.Empty
then
begin
if FRollUpState
then
begin
OldHeight := FForm.Height;
CreateRollUpForm;
end
else
RestoreRollUpForm;
end
else
FRollUpState := False;
if Assigned(FOnChangeRollUpState) then FOnChangeRollUpState(Self);
end;
procedure TspDynamicSkinForm.BeforeUpDateSkinControls;
procedure CheckControl(C: TControl);
begin
if C is TspSkinControl
then
begin
with TspSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then BeforeChangeSkinData;
end
else
if C is TspGraphicSkinControl
then
begin
with TspGraphicSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then BeforeChangeSkinData;
end;
end;
var
i: Integer;
begin
CheckControl(WC);
for i := 0 to WC.ControlCount - 1 do
begin
if WC.Controls[i] is TWinControl
then
BeforeUpDateSkinControls(AFSD, TWinControl(WC.Controls[i]))
else
CheckControl(WC.Controls[i]);
end;
end;
procedure TspDynamicSkinForm.UpDateSkinControls;
procedure CheckControl(C: TControl);
begin
if C is TspGraphicSkinControl
then
begin
with TspGraphicSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TspSkinControl
then
begin
with TspSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TspSkinPageControl
then
begin
with TspSkinPageControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TspSkinTabControl
then
begin
with TspSkinTabControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TspSkinCustomEdit
then
begin
with TspSkinCustomEdit(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinMemo
then
begin
with TspSkinMemo(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinLinkLabel
then
begin
with TspSkinLinkLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinButtonLabel
then
begin
with TspSkinButtonLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinStdLabel
then
begin
with TspSkinStdLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinTextLabel
then
begin
with TspSkinTextLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinCustomTreeView
then
begin
with TspSkinTreeView(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinCustomListView
then
begin
with TspSkinListView(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinHeaderControl
then
begin
with TspSkinHeaderControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinControlBar
then
begin
with TspSkinControlBar(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinSplitter
then
begin
with TspSkinSplitter(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TspSkinBevel
then
begin
with TspSkinBevel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end;
end;
var
i: Integer;
begin
CheckControl(WC);
for i := 0 to WC.ControlCount - 1 do
begin
if WC.Controls[i] is TWinControl
then
UpDateSkinControls(AFSD, TWinControl(WC.Controls[i]))
else
CheckControl(WC.Controls[i]);
end;
end;
procedure TspDynamicSkinForm.UnLinkControlFromArea(Control: TControl);
var
i, j: Integer;
begin
j := -1;
for i := 0 to AreaList.Count - 1 do
begin
if PAreaInfo(AreaList.Items[i])^.Control = Control
then
begin
j := i;
Break;
end;
end;
if j <> -1
then
begin
FreeMem(PAreaInfo(AreaList.Items[i]), Sizeof(TAreaInfo));
AreaList.Delete(j);
end;
end;
procedure TspDynamicSkinForm.LinkControlToArea;
function GetAreaRect: TRect;
var
i: Integer;
begin
i := FSD.GetAreaIndex(AreaName);
if i <> - 1
then
Result := TspDataSkinArea(FSD.AreaList.Items[i]).AreaRect
else
Result := NullRect;
end;
var
PAI: PAreaInfo;
R: TRect;
begin
R := GetAreaRect;
if IsNullRect(R) then Exit;
GetMem(PAI, Sizeof(TAreaInfo));
Control.Align := alNone;
PAI^.Control := Control;
PAI^.AreaRect := R;
AreaList.Add(PAI);
end;
procedure TspDynamicSkinForm.ControlsToAreas;
var
i: Integer;
R: TRect;
FCanScale: Boolean;
begin
if AreaList.Count = 0 then Exit;
FCanScale := CanScale;
for i := 0 to AreaList.Count - 1 do
with PAreaInfo(AreaList.Items[i])^ do
begin
if FCanScale
then
R := CalcRealObjectRect(AreaRect)
else
R := AreaRect;
Control.SetBounds(R.Left, R.Top, RectWidth(R), RectHeight(R));
end;
end;
procedure TspDynamicSkinForm.PopupSkinMenu;
var