Delphi控件源码

开发平台：

Delphi

DynamicSkinForm.pas：源码内容

R: TRect;
begin
SkinMenuOpen;
R := Rect(P.X, P.Y, P.X, P.Y);
if MenusSkinData = nil
then
SkinMenu.Popup(nil, SkinData, 0, R, Menu.Items, False)
else
SkinMenu.Popup(nil, MenusSkinData, 0, R, Menu.Items, False);
end;
procedure TspDynamicSkinForm.PopupSkinMenu1;
begin
SkinMenuOpen;
if MenusSkinData = nil
then
SkinMenu.Popup(nil, SkinData, 0, R, Menu.Items, PopupUp)
else
SkinMenu.Popup(nil, MenusSkinData, 0, R, Menu.Items, PopupUp);
end;
procedure TspDynamicSkinForm.SetMainMenu;
begin
FMainMenu := Value;
if (FSD <> nil) and not FSD.Empty and
not (csDesigning in ComponentState)
then UpDateMainMenu(True);
end;
procedure TspDynamicSkinForm.SkinMenuOpen;
begin
if not InMainMenu
then
begin
HookApp;
end;
if not InMenu
then
begin
InMenu := True;
if Assigned(FOnSkinMenuOpen) then FOnSkinMenuOpen(Self);
end;
end;
procedure TspDynamicSkinForm.SkinMainMenuClose;
var
i: Integer;
begin
InMainMenu := False;
if SkinMenu.Visible then SkinMenu.Hide;
if FMainMenuBar <> nil
then
FMainMenuBar.MenuExit
else
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem then
begin
with TspSkinMainMenuItem(ObjectList.Items[i]) do
if Active then
begin
MouseLeave;
Break;
end;
end;
UnHookApp;
if Assigned(FOnMainMenuExit) then FOnMainMenuExit(Self);
end;
procedure TspDynamicSkinForm.SkinMenuClose2;
var
i: Integer;
begin
InMenu := False;
if FMainMenuBar <> nil
then
FMainMenuBar.MenuClose
else
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem then
begin
with TspSkinMainMenuItem(ObjectList.Items[i]) do
if FDown then
begin
SetDown(False);
MouseEnter;
Break;
end;
end;
if Assigned(FOnSkinMenuClose) then FOnSkinMenuClose(Self);
end;
procedure TspDynamicSkinForm.SkinMenuClose;
var
i: Integer;
begin
InMenu := False;
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem then
begin
with TspSkinMainMenuItem(ObjectList.Items[i]) do
if FDown then
begin
Active := False;
SetDown(False);
Break;
end;
end
else
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinButtonObject then
begin
with TspSkinButtonObject (ObjectList.Items[i]) do
if (MenuItem <> nil) and FDown then
begin
SetDown(False);
Break;
end;
end;
UnHookApp;
if Assigned(FOnSkinMenuClose) then FOnSkinMenuClose(Self);
if InMainMenu
then
begin
InMainMenu := False;
if FMainMenuBar <> nil then FMainMenuBar.MenuExit;
if Assigned(FOnMainMenuExit) then FOnMainMenuExit(Self);
end;
end;
procedure TspDynamicSkinForm.CheckWindowState;
begin
if (ActiveObject <> -1)
then
if TspActiveSkinObject(ObjectList.Items[ActiveObject]) is TspSkinCaptionObject
then
begin
if FRollUpState
then
RollUpState := False
else
if not FSizeAble
then
RollUpState := True
else
if WindowState = wsNormal
then WindowState := wsMaximized
else WindowState := wsNormal;
end;
end;
procedure TspDynamicSkinForm.CheckObjects;
var
i, j: Integer;
B: Boolean;
begin
if ObjectList.Count > 0 then
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinAnimateObject
then
with TspSkinAnimateObject(ObjectList.Items[i]) do
begin
if ButtonStyle and (Command <> cmDefault)
then
begin
if not (biRollUp in FBorderIcons) and
(Command = cmRollUp)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if not (biMaximize in FBorderIcons) and
(Command = cmMaximize)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if not (biMinimize in FBorderIcons) and
(Command = cmMinimize)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if not (biSystemMenu in FBorderIcons) and
(Command = cmSysMenu)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end;
end;
end
else
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinStdButtonObject
then
with TspSkinStdButtonObject(ObjectList.Items[i]) do
begin
if not (biRollUp in FBorderIcons) and (Command = cmRollUp)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if not (biMaximize in FBorderIcons) and (Command = cmMaximize)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if not (biMinimize in FBorderIcons) and (Command = cmMinimize)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if not (biSystemMenu in FBorderIcons) and (Command = cmSysMenu)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end;
end
else
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject
then
with TspSkinCaptionObject(ObjectList.Items[i]) do
begin
if DefaultCaption
then FTextValue := FForm.Caption;
end;
B := False;
j := -1;
if ObjectList.Count > 0
then
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject
then
with TspSkinCaptionObject(ObjectList.Items[i]) do
if DefaultCaption
then
begin
B := True;
Break;
end
else
if j = -1 then j := i;
if (j <> -1) and not B and
(TspActiveSkinObject(ObjectList.Items[j]) is TspSkinCaptionObject)
then
with TspSkinCaptionObject(ObjectList.Items[j]) do
begin
DefaultCaption := True;
FTextValue := FForm.Caption;
end;
end;
function TspDynamicSkinForm.CanScale;
begin
if (FSD.RBPoint.X - FSD.LTPoint.X = 0) or
(FSD.RBPoint.Y - FSD.LTPoint.Y = 0)
then
Result := False
else
Result := True;
end;
function TspDynamicSkinForm.GetIndex;
var
i, j: Integer;
begin
j := -1;
for i := 0 to ObjectList.Count - 1 do
begin
if AIDName = TspActiveSkinObject(ObjectList.Items[i]).IDName
then
begin
j := i;
Break;
end;
end;
Result := j;
end;
procedure TspDynamicSkinForm.UserObjectDraw;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> -1
then
if TspActiveSkinObject(ObjectList.Items[i]) is TspUserObject
then
TspUserObject(ObjectList.Items[i]).Draw(FForm.Canvas, True);
end;
procedure TspDynamicSkinForm.SwitchChangeStateEvent;
begin
if Assigned(FOnSwitchChangeStateEvent)
then FOnSwitchChangeStateEvent(IDName, State);
end;
procedure TspDynamicSkinForm.AnimateStart;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinAnimateObject
then
TspSkinAnimateObject(ObjectList.Items[i]).Start;
end;
procedure TspDynamicSkinForm.AnimateStop;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinAnimateObject
then
TspSkinAnimateObject(ObjectList.Items[i]).Stop;
end;
procedure TspDynamicSkinForm.TrackBarChangeValueEvent;
begin
if Assigned(FOnTrackBarChangeValueEvent)
then FOnTrackBarChangeValueEvent(IDName, Value);
end;
procedure TspDynamicSkinForm.FrameRegulatorChangeValueEvent;
begin
if Assigned(FOnFrameRegulatorChangeValueEvent)
then FOnFrameRegulatorChangeValueEvent(IDName, Value);
end;
function TspDynamicSkinForm.TrackBarGetValue;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> -1
then
begin
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinTrackBarObject
then
with TspSkinTrackBarObject(ObjectList.Items[i]) do Result := Value
else
Result := 0;
end
else
Result := 0;
end;
procedure TspDynamicSkinForm.BitLabelSetText;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinBitLabelObject
then
with TspSkinBitLabelObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SetTextValue(AValue, False)
else SetTextValue(AValue, True);
end;
procedure TspDynamicSkinForm.GaugeSetValue;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinGaugeObject
then
with TspSkinGaugeObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SimplySetValue(AValue)
else Value := AValue;
end;
procedure TspDynamicSkinForm.FrameGaugeSetValue;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinFrameGaugeObject
then
with TspSkinFrameGaugeObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SimplySetValue(AValue)
else Value := AValue;
end;
procedure TspDynamicSkinForm.LabelSetText;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinLabelObject
then
with TspSkinLabelObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SetTextValue(ATextValue, False)
else SetTextValue(ATextValue, True);
end;
function TspDynamicSkinForm.FrameRegulatorGetValue;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> -1
then
begin
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinFrameRegulatorObject
then
with TspSkinFrameRegulatorObject(ObjectList.Items[i]) do Result := Value
else
Result := 0;
end
else
Result := 0;
end;
procedure TspDynamicSkinForm.FrameRegulatorSetValue;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinFrameRegulatorObject
then
with TspSkinFrameRegulatorObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SimplySetValue(AValue)
else Value := AValue;
end;
procedure TspDynamicSkinForm.TrackBarSetValue;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinTrackBarObject
then
with TspSkinTrackBarObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SimplySetValue(AValue)
else Value := AValue;
end;
procedure TspDynamicSkinForm.DoMagnetic;
var
R: TRect;
LW, TR: Integer;
P: TPoint;
begin
if FForm.FormStyle <> fsMDIChild
then
R := GetMonitorWorkArea(FForm.Handle, True)
else
begin
R := GetMDIWorkArea;
P := Application.MainForm.ClientToScreen(Point(0, 0));
OffsetRect(R, P.X, P.Y);
end;
if (L < R.Left + FMagneticSize) and (L > R.Left - FMagneticSize)
then L := R.Left;
if (T < R.Top + FMagneticSize) and (T > R.Top - FMagneticSize)
then T := R.Top;
LW := L + W; TR := T + H;
if (LW > R.Right - FMagneticSize) and (LW < R.Right + FMagneticSize)
then L := R.Right - W;
if (TR > R.Bottom - FMagneticSize) and (TR < R.Bottom + FMagneticSize)
then T := R.Bottom - H;
end;
function TspDynamicSkinForm.InForm;
var
H: HWND;
begin
H := WindowFromPoint(P);
Result := H = FForm.Handle;
end;
function TspDynamicSkinForm.PtInMask;
var
B: Boolean;
begin
if PtInRect(NewMaskRectArea, P)
then
B := True
else
if P.Y <= NewMaskRectArea.Top
then
B := RMTop.Canvas.Pixels[P.X, P.Y] = BlackColor
else
if P.Y >= NewMaskRectArea.Bottom
then
B := RMBottom.Canvas.Pixels[P.X, P.Y - NewMaskRectArea.Bottom] = BlackColor
else
if P.X <= NewMaskRectArea.Left
then
B := RMLeft.Canvas.Pixels[P.X, P.Y - NewMaskRectArea.Top] = BlackColor
else
B := RMRight.Canvas.Pixels[P.X - NewMaskRectArea.Right, P.Y - NewMaskRectArea.Top] = BlackColor;
Result := B;
end;
procedure TspDynamicSkinForm.SetWindowState;
begin
if FWindowState <> Value
then
begin
if not ((Value = wsMinimized) and (FForm = Application.MainForm))
then
FWindowState := Value;
case Value of
wsNormal: DoNormalize;
wsMaximized: DoMaximize;
wsMinimized: DoMinimize;
end;
end;
end;
procedure TspDynamicSkinForm.DoMinimize;
var
P: TPoint;
begin
if (Application.MainForm = FForm) or not FSupportNCArea
then
Application.Minimize
else
begin
if IsNullRect(OldBoundsRect)
then OldBoundsRect := FForm.BoundsRect;
P := GetMinimizeCoord;
FForm.SetBounds(P.X, P.Y, GetMinWidth, GetMinHeight);
if (FForm.FormStyle = fsMDIChild) and (FWindowState <> wsMaximized)
then
begin
SendMessage(Application.MainForm.Handle, WM_MDICHILDRESTORE, 0, 0);
end;
end;
end;
procedure TspDynamicSkinForm.DoMaximize;
var
R, R1: TRect;
OW, OH: Integer;
begin
if IsNullRect(OldBoundsRect) then OldBoundsRect := FForm.BoundsRect;
if FForm.FormStyle = fsMDIChild
then
begin
MouseTimer.Enabled := False;
TestActive(-1, -1, False);
R := GetMDIWorkArea;
OW := FForm.Width;
OH := FForm.Height;
FForm.SetBounds(0, 0, RectWidth(R), RectHeight(R));
if (OW = RectWidth(R)) and (OH = RectHeight(R)) then UpDateForm;
SendMessage(Application.MainForm.Handle, WM_MDICHILDMAX, 0, 0);
end
else
begin
if not FMaximizeOnFullScreen
then
begin
R := GetMonitorWorkArea(FForm.Handle, True);
R1 := GetMonitorWorkArea(FForm.Handle, False);
if (RectWidth(R) = RectWidth(R1)) and
(RectHeight(R) = RectHeight(R1))
then
InflateRect(R, -1, -1);
end
else
R := GetMonitorWorkArea(FForm.Handle, False);
FForm.SetBounds(R.Left, R.Top, RectWidth(R), RectHeight(R));
end;
end;
procedure TspDynamicSkinForm.DoNormalize;
var
OW, OH: Integer;
begin
MaxRollUpState := False;
if FSupportNCArea
then
begin
OW := FForm.Width;
OH := FForm.Height;
FForm.SetBounds(OldBoundsRect.Left, OldBoundsRect.Top,
RectWidth(OldBoundsRect),
RectHeight(OldBoundsRect));
MouseTimer.Enabled := True;
if (OW = RectWidth(OldBoundsRect)) and
(OH = RectHeight(OldBoundsRect))
then
UpDateForm;
FForm.RePaint;
if (FForm.FormStyle = fsMDIChild) and (FWindowState <> wsMaximized)
then
begin
SendMessage(Application.MainForm.Handle, WM_MDICHILDRESTORE, 0, 0);
end;
OldBoundsRect := NullRect;
end
else
begin
FForm.SetBounds(OldBoundsRect.Left,OldBoundsRect.Top,
RectWidth(OldBoundsRect),
RectHeight(OldBoundsRect));
OldBoundsRect := NullRect;
MouseTimer.Enabled := True;
end;
end;
procedure TspDynamicSkinForm.LinkMenu;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if (TspActiveSkinObject(ObjectList.Items[i]) is TspSkinButtonObject)
then
with TspSkinButtonObject(ObjectList.Items[i]) do
begin
MenuItem := AMenu.Items;
FPopupUp := APopupUp;
end
else
if (TspActiveSkinObject(ObjectList.Items[i]) is TspSkinAnimateObject)
then
with TspSkinAnimateObject(ObjectList.Items[i]) do
if ButtonStyle
then
begin
MenuItem := AMenu.Items;
FPopupUp := APopupUp;
end;
end;
procedure TspDynamicSkinForm.CheckSize;
var
CS: Boolean;
begin
CS := CanScale;
if not CS
then
begin
if FForm.ClientWidth <> FSD.FPicture.Width
then FForm.ClientWidth := FSD.FPicture.Width;
if FForm.ClientHeight <> FSD.FPicture.Height
then FForm.ClientHeight := FSD.FPicture.Height;
FSizeAble := False;
end
else
if (FMinWidth = 0) or (FMinHeight = 0)
then
begin
if FForm.ClientWidth < FSD.FPicture.Width
then
FForm.ClientWidth := FSD.FPicture.Width;
if FForm.ClientHeight < FSD.FPicture.Height
then
FForm.ClientHeight := FSD.FPicture.Height;
end;
end;
procedure TspDynamicSkinForm.UpDateForm;
begin
with FForm do
begin
if Width - 1 >= GetMinWidth
then
begin
Width := Width - 1;
Width := Width + 1;
end
else
begin
Width := Width + 1;
Width := Width - 1;
end;
end;
end;
procedure TspDynamicSkinForm.ChangeSkinData;
var
CS: Boolean;
NotRollUp: Boolean;
begin
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
if (FSD = nil) or (FSD.Empty)
then
FSkinSupport := False
else
FSkinSupport := True;
if FSupportNCArea
then
begin
if FSkinSupport
then
begin
LoadObjects;
CheckObjects;
end
else
begin
ClearObjects;
CreateNewRegion(True);
end;
FInChangeSkinData := True;
if (FForm.Width < GetMinWidth) and (FForm.Height < GetMinHeight)
then
begin
FForm.SetBounds(FForm.Left, FForm.Top,
GetMinWidth, GetMinHeight);
end
else
if FForm.Height < GetMinHeight then FForm.Height := GetMinHeight else
if FForm.Width < GetMinWidth then FForm.Width := GetMinWidth else
UpDateForm;
if (FRollUpState or (FWindowState = wsMinimized)) and
(FForm.Height <> GetMinHeight)
then
FForm.Height := GetMinHeight;
if (FWindowState = wsMinimized) and (FForm.Width <> GetMinWidth)
then
FForm.Width := GetMinWidth;
FFormWidth := FForm.Width;
FFormHeight := FForm.Height;
if FSkinSupport then CreateNewForm(True);
if (FForm.FormStyle = fsMDIForm)
then
begin
ReDrawWindow(FForm.ClientHandle, nil, 0, RDW_ERASE or RDW_INVALIDATE);
ResizeMDIChilds;
end
else
FForm.RePaint;
if (FForm.FormStyle = fsMDIChild) and (WindowState = wsMaximized)
then FormChangeActive(False)
else FormChangeActive(True);
MouseTimer.Enabled := True;
if Assigned(FOnChangeSkinData) then FOnChangeSkinData(Self);
FInChangeSkinData := False;
end
else
if FSkinSupport
then
begin
CS := CanScale;
NotRollUp := FRollUpState and FSD.FRollUpPicture.Empty;
if NotRollUp
then
begin
FRollUpState := False;
RestoreRollUpForm;
end;
if not FRollUpState then CheckSize;
LoadObjects;
CheckObjects;
if not NotRollUp and FRollUpState then CreateRollUpForm;
FInChangeSkinData := True;
if Assigned(FOnChangeSkinData) then FOnChangeSkinData(Self);
if not FRollUpState then
if CS or (not CS and (FForm.ClientWidth = FSD.FPicture.Width) and
(FForm.ClientHeight = FSD.FPicture.Height))
then CreateNewForm(CS);
LinkControlsToAreas;
ControlsToAreas;
FormChangeActive(True);
FInChangeSkinData := False;
MouseTimer.Enabled := True;
end;
end;
procedure TspDynamicSkinForm.SetSkinData(Value: TspSkinData);
begin
FSD := Value;
{if (FSD <> nil) then}
if {not FSD.Empty and} not (csDesigning in ComponentState) then ChangeSkinData;
FSysTrayMenu.SkinData := Value;
end;
procedure TspDynamicSkinForm.SetMenusSkinData(Value: TspSkinData);
begin
FMSD := Value;
end;
procedure TspDynamicSkinForm.LinkControlsToAreas;
var
i: Integer;
begin
with FForm do
for i := 0 to ControlCount - 1 do
if Controls[i] is TspSkinControl
then
begin
if TspSkinControl(Controls[i]).AreaName <> ''
then
LinkControlToArea(TspSkinControl(Controls[i]).AreaName, Controls[i]);
end
else
if Controls[i] is TspGraphicSkinControl
then
begin
if TspGraphicSkinControl(Controls[i]).AreaName <> ''
then
LinkControlToArea(TspGraphicSkinControl(Controls[i]).AreaName, Controls[i]);
end;
end;
procedure TspDynamicSkinForm.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD)
then FSD := nil else
if (Operation = opRemove) and (AComponent = FMSD)
then FMSD := nil else
if (Operation = opRemove) and (AComponent = FMainMenu)
then FMainMenu := nil else
if (Operation = opRemove) and (AComponent = FSystemMenu)
then FSystemMenu := nil else
if (Operation = opRemove) and (AComponent = FMainMenuBar)
then FMainMenuBar := nil else
if (Operation = opRemove) and (AComponent = FMDITabsBar)
then FMDITabsBar := nil else
if (Operation = opRemove) and (AComponent = FTrayIcon)
then FTrayIcon := nil;
if (Operation = opRemove) and (AComponent = FSkinHint)
then FSkinHint := nil;
end;
procedure TspDynamicSkinForm.UpdateMainMenu;
function DeleteMainMenuItem: Boolean;
var
i, j: Integer;
begin
j := -1;
for i := ObjectList.Count - 1 downto 0 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
begin
j := i;
Break;
end;
if j <> - 1
then
begin
TspSkinMainMenuItem(ObjectList.Items[j]).Free;
ObjectList.Delete(j);
Result := True;
end
else
Result := False;
end;
var
R: TRect;
begin
//delete old items
repeat
until not DeleteMainMenuItem;
//create new menu
CreateMainMenu;
R := NewMainMenuRect;
if ARedraw
then
if SupportNCArea
then
SendMessage(FForm.Handle, WM_NCPaint, 0, 0)
else
InvalidateRect(FForm.Handle, @R, True);
end;
procedure TspDynamicSkinForm.CreateMainMenu;
var
i, j: Integer;
MMIData: TspDataSkinMainMenuItem;
begin
if FMainMenu = nil then Exit;
j := FSD.GetIndex('MAINMENUITEM');
if j <> -1
then
begin
MMIData := TspDataSkinMainMenuItem(FSD.ObjectList.Items[j]);
for i := 0 to FMainMenu.Items.Count - 1 do
if FMainMenu.Items[i].Visible
then
begin
ObjectList.Add(TspSkinMainMenuItem.Create(Self, MMIData));
with TspSkinMainMenuItem(ObjectList.Items[ObjectList.Count - 1]) do
begin
IDName := FMainMenu.Items[i].Name;
Enabled := FMainMenu.Items[i].Enabled;
MenuItem := FMainMenu.Items[i];
end;
end;
end;
end;
procedure TspDynamicSkinForm.LoadDefObjects;
var
NotNullRect: TRect;
begin
ClearObjects;
NotNullRect := Rect(0, 0, 1, 1);
ObjectList.Add(TspSkinStdButtonObject.Create(Self, nil));
with TspSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmClose;
IDName := 'closebutton';
end;
ObjectList.Add(TspSkinStdButtonObject.Create(Self, nil));
with TspSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmMaximize;
IDName := 'maxbutton';
end;
ObjectList.Add(TspSkinStdButtonObject.Create(Self, nil));
with TspSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmMinimize;
IDName := 'minbutton';
end;
ObjectList.Add(TspSkinStdButtonObject.Create(Self, nil));
with TspSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmRollUp;
IDName := 'rollupbutton';
end;
ObjectList.Add(TspSkinStdButtonObject.Create(Self, nil));
with TspSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmSysMenu;
IDName := 'sysmenubutton';
end;
CheckObjects;
end;
procedure TspDynamicSkinForm.LoadObjects;
var
i: Integer;
OL: TList;
begin
ClearObjects;
OL := FSD.ObjectList;
for i := 0 to OL.Count - 1 do
begin
if (TspDataSkinObject(OL.Items[i]) is TspDataSkinMainMenuItem) or
(TspDataSkinObject(OL.Items[i]) is TspDataSkinMenuItem) or
(TspDataSkinObject(OL.Items[i]) is TspDataSkinMainMenuBarButton)
then
begin
end
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinGauge
then
ObjectList.Add(TspSkinGaugeObject.Create(Self, TspDataSkinGauge(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinStdButton
then
ObjectList.Add(TspSkinStdButtonObject.Create(Self, TspDataSkinStdButton(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinButton
then ObjectList.Add(TspSkinButtonObject.Create(Self, TspDataSkinButton(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinCaption
then ObjectList.Add(TspSkinCaptionObject.Create(Self, TspDataSkinCaption(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataUserObject
then ObjectList.Add(TspUserObject.Create(Self, TspDataUserObject(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinSwitch
then ObjectList.Add(TspSkinSwitchObject.Create(Self, TspDataSkinSwitch(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinTrackBar
then ObjectList.Add(TspSkinTrackBarObject.Create(Self, TspDataSkinTrackBar(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinLabel
then ObjectList.Add(TspSkinLabelObject.Create(Self, TspDataSkinLabel(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinAnimate
then ObjectList.Add(TspSkinAnimateObject.Create(Self, TspDataSkinAnimate(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinBitLabel
then ObjectList.Add(TspSkinBitLabelObject.Create(Self, TspDataSkinBitLabel(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinFrameRegulatorObject
then ObjectList.Add(TspSkinFrameRegulatorObject.Create(Self,
TspDataSkinFrameRegulatorObject(OL.Items[i])))
else
if TspDataSkinObject(OL.Items[i]) is TspDataSkinFrameGaugeObject
then ObjectList.Add(TspSkinFrameGaugeObject.Create(Self,
TspDataSkinFrameGaugeObject(OL.Items[i])));
end;
CreateMainMenu;
end;
procedure TspDynamicSkinForm.ClearObjects;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
TspActiveSkinObject(ObjectList.Items[i]).Free;
ObjectList.Clear;
for i := 0 to AreaList.Count - 1 do
FreeMem(PAreaInfo(AreaList.Items[i]), Sizeof(TAreaInfo));
AreaList.Clear;
end;
procedure TspDynamicSkinForm.TestActive;
var
i: Integer;
B: Boolean;
ObjHint: String;
begin
if (ObjectList.Count = 0) or (not GetFormActive and FSupportNCArea)
then
Exit;
OldActiveObject := ActiveObject;
i := -1;
B := False;
repeat
Inc(i);
with TspActiveSkinObject(ObjectList.Items[i]) do
begin
if CanObjectTest(RollUp) and Enabled and Visible
then
B := PtInRect(ObjectRect, Point(X, Y));
end;
until B or (i = ObjectList.Count - 1);
if B and InFrm
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
begin
if TspActiveSkinObject(ObjectList.Items[OldActiveObject]).Enabled and
TspActiveSkinObject(ObjectList.Items[OldActiveObject]).Visible
then TspActiveSkinObject(ObjectList.Items[OldActiveObject]).MouseLeave;
if FShowObjectHint and (FSkinHint <> nil) and
TspActiveSkinObject(ObjectList.Items[OldActiveObject]).Enabled and
(TspActiveSkinObject(ObjectList.Items[OldActiveObject]).Hint <> '') and
TspActiveSkinObject(ObjectList.Items[OldActiveObject]).Visible
then FSkinHint.HideHint;
end;
if ActiveObject <> -1
then
begin
if TspActiveSkinObject(ObjectList.Items[ActiveObject]).Enabled and
TspActiveSkinObject(ObjectList.Items[ActiveObject]).Visible
then TspActiveSkinObject(ObjectList.Items[ActiveObject]).MouseEnter;
// show object hint
if GetFormActive and
FShowObjectHint and (FSkinHint <> nil) and
TspActiveSkinObject(ObjectList.Items[ActiveObject]).Enabled and
TspActiveSkinObject(ObjectList.Items[ActiveObject]).Visible
then
begin
ObjHint := TspActiveSkinObject(ObjectList.Items[ActiveObject]).Hint;
if ObjHint <> '' then FSkinHint.ActivateHint2(ObjHint);
end;
//
end;
end;
end;
procedure TspDynamicSkinForm.TestCursors;
var
CurIndex: Integer;
begin
CurIndex := 0;
if ActiveObject = -1
then
begin
if FSD.CursorIndex <> -1
then
CurIndex := FSD.StartCursorIndex + FSD.CursorIndex
end
else
with TspActiveSkinObject(ObjectList.Items[ActiveObject]) do
begin
if CursorIndex <> -1
then
CurIndex := FSD.StartCursorIndex + CursorIndex
else
if FSD.CursorIndex <> -1
then
CurIndex := FSD.CursorIndex + FSD.StartCursorIndex;
end;
if FForm.Cursor <> CurIndex
then
FForm.Cursor := CurIndex;
end;
procedure TspDynamicSkinForm.TestMouse;
var
P, P1: TPoint;
B: Boolean;
L, T: Integer;
begin
if not FSkinSupport and not FSupportNCArea then Exit;
if FSupportNCArea
then
begin
GetCursorPos(P);
if not FSizeMove then
begin
PointToNCPoint(P);
if not PtInRect(NewClRect, P)
then
TestActive(P.X, P.Y, True)
else
if ActiveObject <> -1 then TestActive(-1, -1, True);
end
else
MouseTimer.Enabled := False;
end
else
begin
GetCursorPos(P1);
P := FForm.ScreenToClient(P1);
if FIsDragging
then
begin
if (P1.X <> FOLDX) or (P1.Y <> FOLDY)
then
begin
L := FForm.Left + P1.X - FOldX;
T := FForm.Top + P1.Y - FOldY;
if FMagnetic
then
begin
DoMagnetic(L, T, FForm.Width, FForm.Height);
end;
FForm.SetBounds(L, T, FForm.Width, FForm.Height);
FOLDX := P1.X;
FOLDY := P1.Y;
end;
end
else
begin
B := InForm(P1);
if not B
then
begin
TestActive(-1, -1, False);
MouseIn := False;
MouseTimer.Enabled := False;
end
else
TestActive(P.X, P.Y, B);
end;
if FUseSkinCursors then TestCursors;
end;
end;
procedure TspDynamicSkinForm.TestAnimate;
var
i: Integer;
StopAnimate: Boolean;
begin
StopAnimate := True;
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinAnimateObject
then
with TspSkinAnimateObject(ObjectList.Items[i]) do
if Active
then
begin
ChangeFrame;
StopAnimate := False;
end;
if StopAnimate
then AnimateTimer.Enabled := False;
end;
procedure TspDynamicSkinForm.TestMorph;
var
i: Integer;
StopMorph: Boolean;
begin
StopMorph := True;
for i := 0 to ObjectList.Count - 1 do
with TspActiveSkinObject(ObjectList.Items[i]) do
begin
if Morphing and CanMorphing
then
begin
DoMorphing;
StopMorph := False;
end;
end;
if StopMorph then MorphTimer.Enabled := False;
end;
procedure TspDynamicSkinForm.PaintEvent;
begin
if Assigned(FOnPaintEvent) then FOnPaintEvent(IDName, Canvas, ObjectRect);
end;
procedure TspDynamicSkinForm.MouseUpEvent;
begin
if Assigned(FOnMouseUpEvent)
then FOnMouseUpEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TspDynamicSkinForm.MouseDownEvent;
begin
if Assigned(FOnMouseDownEvent)
then FOnMouseDownEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TspDynamicSkinForm.MouseMoveEvent;
begin
if Assigned(FOnMouseMoveEvent)
then FOnMouseMoveEvent(IDName, X, Y, ObjectRect);
end;
procedure TspDynamicSkinForm.MouseEnterEvent;
begin
if Assigned(FOnMouseEnterEvent) then FOnMouseEnterEvent(IDName);
end;
procedure TspDynamicSkinForm.MouseLeaveEvent;
begin
if Assigned(FOnMouseLeaveEvent) then FOnMouseLeaveEvent(IDName);
end;
procedure TspDynamicSkinForm.StartDragg;
var
P: TPoint;
begin
FIsDragging := True;
P := FForm.ClientToScreen(Point(X, Y));
FOldX := P.X;
FOldy := P.Y;
end;
procedure TspDynamicSkinForm.EndDragg;
begin
FIsDragging := False;
end;
procedure TspDynamicSkinForm.MouseMove;
begin
if FSupportNCArea
then
begin
if MouseCaptureObject <> -1
then TspActiveSkinObject(ObjectList.Items[MouseCaptureObject]).MouseMove(X, Y)
else
if ActiveObject <> -1
then TspActiveSkinObject(ObjectList.Items[ActiveObject]).MouseMove(X, Y);
end
else
begin
if not FIsDragging
then
if MouseCaptureObject <> -1
then TspActiveSkinObject(ObjectList.Items[MouseCaptureObject]).MouseMove(X, Y)
else
if ActiveObject <> -1
then TspActiveSkinObject(ObjectList.Items[ActiveObject]).MouseMove(X, Y);
end;
end;
procedure TspDynamicSkinForm.MouseDblClick;
begin
if (ActiveObject <> - 1) then
with TspActiveSkinObject(ObjectList.Items[ActiveObject]) do
begin
DblClick;
end;
end;
procedure TspDynamicSkinForm.MouseDown;
begin
if FSupportNCArea
then
begin
if (ActiveObject <> - 1) then
with TspActiveSkinObject(ObjectList.Items[ActiveObject]) do
begin
if not (TspActiveSkinObject(ObjectList.Items[ActiveObject]) is
TspSkinCaptionObject)
then SetCapture(FForm.Handle);
MouseCaptureObject := ActiveObject;
MouseDown(X, Y, Button);
end
end
else
begin
FIsDragging := False;
TestActive(X, Y, True);
if (ActiveObject <> - 1)
then
with TspActiveSkinObject(ObjectList.Items[ActiveObject]) do
begin
MouseCaptureObject := ActiveObject;
MouseDown(X, Y, Button);
end
else
if (Button = mbLeft) and (FWindowState <> wsMaximized) and FDraggable
then
StartDragg(X, Y);
end;
end;
procedure TspDynamicSkinForm.MouseUp;
begin
if FSupportNCArea
then
begin
if (MouseCaptureObject <> -1)
then
begin
if not (TspActiveSkinObject(ObjectList.Items[MouseCaptureObject]) is
TspSkinCaptionObject)
then ReleaseCapture;
TspActiveSkinObject(ObjectList.Items[MouseCaptureObject]).MouseUp(X, Y, Button);
MouseCaptureObject := -1;
end;
end
else
begin
EndDragg;
if (MouseCaptureObject <> -1)
then
begin
TspActiveSkinObject(ObjectList.Items[MouseCaptureObject]).MouseUp(X, Y, Button);
MouseCaptureObject := -1;
end;
end;
end;
procedure TspDynamicSkinForm.CreateRealBitMap;
begin
CreateSkinImage(FSD.LTPoint, FSD.RTPoint, FSD.LBPoint, FSD.RBPoint,
FSD.ClRect, NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewClRect,
DestB, SourceB, Rect(0, 0, SourceB.Width, SourceB.Height), FFormWidth,
FFormHeight, True);
end;
function TspDynamicSkinForm.CalcRealObjectRect;
var
NewR: TRect;
LeftTop, LeftBottom, RightTop, RightBottom: TRect;
OffsetX, OffsetY: Integer;
function CorrectResizeRect: TRect;
var
NR: TRect;
begin
NR := R;
if PtInRect(LeftTop, R.TopLeft) and
PtInRect(RightBottom, R.BottomRight)
then
begin
Inc(NR.Right, OffsetX);
Inc(NR.Bottom, OffsetY);
end
else
if PtInRect(LeftTop, R.TopLeft) and
PtInRect(RightTop, R.BottomRight)
then
Inc(NR.Right, OffsetX)
else
if PtInRect(LeftBottom, R.TopLeft) and
PtInRect(RightBottom, R.BottomRight)
then
begin
Inc(NR.Right, OffsetX);
OffsetRect(NR, 0, OffsetY);
end
else
if PtInRect(LeftTop, R.TopLeft) and
PtInRect(LeftBottom, R.BottomRight)
then
Inc(NR.Bottom, OffsetY)
else
if PtInRect(RightTop, R.TopLeft) and
PtInRect(RightBottom, R.BottomRight)
then
begin
OffsetRect(NR, OffsetX, 0);
Inc(NR.Bottom, OffsetY);
end;
Result := NR;
end;
begin
LeftTop := Rect(0, 0, FSD.LTPoint.X, FSD.LTPoint.Y);
LeftBottom := Rect(0, FSD.LBPoint.Y, FSD.LBPoint.X, FSD.FPicture.Height);
RightTop := Rect(FSD.RTPoint.X, 0, FSD.FPicture.Width, FSD.RTPoint.Y);
RightBottom := Rect(FSD.RBPoint.X, FSD.RBPoint.Y, FSD.FPicture.Width, FSD.FPicture.Height);
OffsetX := NewRBPoint.X - FSD.RBPoint.X;
OffsetY := NewRBPoint.Y - FSD.RBPoint.Y;
NewR := R;
if RectInRect(R, LeftTop)
then NewR := R
else
if RectInRect(R, RightTop)
then OffsetRect(NewR, OffsetX, 0)
else
if RectInRect(R, LeftBottom)
then OffsetRect(NewR, 0, OffsetY)
else
if RectInRect(R, RightBottom)
then
OffsetRect(NewR, OffsetX, OffsetY)
else
NewR := CorrectResizeRect;
Result := NewR;
end;
procedure TspDynamicSkinForm.CalcAllRealObjectRect;
var
i: Integer;
OffsetX, OffsetY, BW, BH: Integer;
Button: TspActiveSkinObject;
C: TspSkinCaptionObject;
function GetCaption: TspSkinCaptionObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[I]) is TspSkinCaptionObject
then
begin
Result := TspSkinCaptionObject(ObjectList.Items[I]);
Break;
end;
end;
function GetStdButton(C: TStdCommand): TspActiveSkinObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[I]) is TspSkinStdButtonObject
then
begin
with TspSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TspActiveSkinObject(ObjectList.Items[I]);
Break;
end;
end
else
if TspActiveSkinObject(ObjectList.Items[I]) is TspSkinAnimateObject
then
begin
with TspSkinAnimateObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TspActiveSkinObject(ObjectList.Items[I]);
Break;
end;
end;
end;
procedure SetStdButtonRect(B: TspActiveSkinObject);
begin
if (B <> nil) and (B is TspSkinStdButtonObject)
then
begin
with TspSkinStdButtonObject(B) do
begin
if (Command = cmSysMenu) and Parent.ShowIcon and SkinRectInAPicture
then
GetIconSize(BW, BH)
else
begin
BW := RectWidth(SkinRect);
BH := RectHeight(SkinRect);
end;
ObjectRect := Rect(OffsetX - BW, OffsetY, OffsetX, OffsetY + BH);
OffsetX := OffsetX - NewButtonsOffset - BW;
end;
end
else
if (B <> nil) and (B is TspSkinAnimateObject)
then
begin
with TspSkinAnimateObject(B) do
begin
{if (Command = cmSysMenu) and Parent.ShowIcon and SkinRectInAPicture
then
GetIconSize(BW, BH)
else
begin}
BW := RectWidth(SkinRect);
BH := RectHeight(SkinRect);
{ end;}
ObjectRect := Rect(OffsetX - BW, OffsetY, OffsetX, OffsetY + BH);
OffsetX := OffsetX - NewButtonsOffset - BW;
end;
end
end;
procedure SetStdButtonRect2(B: TspActiveSkinObject);
begin
if (B <> nil) and (B is TspSkinStdButtonObject)
then
begin
with TspSkinStdButtonObject(B) do
begin
if (Command = cmSysMenu) and Parent.ShowIcon and SkinRectInAPicture
then
GetIconSize(BW, BH)
else
begin
BW := RectWidth(SkinRect);
BH := RectHeight(SkinRect);
end;
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + BW, OffsetY + BH);
OffsetX := OffsetX + NewButtonsOffset + BW;
end;
end
else
if (B <> nil) and (B is TspSkinAnimateObject)
then
begin
with TspSkinAnimateObject(B) do
begin
{ if (Command = cmSysMenu) and Parent.ShowIcon and SkinRectInAPicture
then
GetIconSize(BW, BH)
else
begin}
BW := RectWidth(SkinRect);
BH := RectHeight(SkinRect);
{ end;}
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + BW, OffsetY + BH);
OffsetX := OffsetX + NewButtonsOffset + BW;
end;
end
end;
procedure SetStdObjectsRect;
begin
Button := GetStdButton(cmClose);
SetStdButtonRect(Button);
Button := GetStdButton(cmMaximize);
SetStdButtonRect(Button);
Button := GetStdButton(cmMinimize);
SetStdButtonRect(Button);
Button := GetStdButton(cmRollUp);
SetStdButtonRect(Button);
C := GetCaption;
if IsNullRect(NewButtonsRect) and (C <> nil)
then
C.ObjectRect.Right := OffsetX + NewButtonsOffset;
OffsetX := NewCaptionRect.Left;
Button := GetStdButton(cmSysMenu);
if Button <> nil
then
begin
OffsetY := NewCaptionRect.Top;
SetStdButtonRect2(Button);
Button.ObjectRect.Top := OffsetY + RectHeight(NewCaptionRect) div 2 -
BH div 2;
Button.ObjectRect.Bottom := Button.ObjectRect.Top + BH;
if C <> nil
then
C.ObjectRect.Left := OffsetX - NewButtonsOffset;
end;
end;
procedure SetStdObjectsRect2;
begin
Button := GetStdButton(cmClose);
SetStdButtonRect2(Button);
Button := GetStdButton(cmMaximize);
SetStdButtonRect2(Button);
Button := GetStdButton(cmMinimize);
SetStdButtonRect2(Button);
Button := GetStdButton(cmRollUp);
SetStdButtonRect2(Button);
if IsNullRect(NewButtonsRect) and NewButtonsInLeft
then
begin
Button := GetStdButton(cmSysmenu);
SetStdButtonRect2(Button);
end;
C := GetCaption;
if IsNullRect(NewButtonsRect) and (C <> nil)
then C.ObjectRect.Left := OffsetX + NewButtonsOffset;
if not NewButtonsInLeft and not IsNullRect(NewCaptionRect)
then
begin
OffsetY := NewCaptionRect.Top;
OffsetX := NewCaptionRect.Left;
Button := GetStdButton(cmSysMenu);
if Button <> nil
then
begin
SetStdButtonRect2(Button);
Button.ObjectRect.Top := OffsetY + RectHeight(NewCaptionRect) div 2 -
BH div 2;
Button.ObjectRect.Bottom := Button.ObjectRect.Top + BH;
if C <> nil
then
C.ObjectRect.Left := OffsetX - NewButtonsOffset;
end;
end;
end;
begin
for i := 0 to ObjectList.Count - 1 do
with TspActiveSkinObject(ObjectList.Items[i]) do
ObjectRect := CalcRealObjectRect(SkinRect);
// caption buttons rects
if IsNullRect(NewButtonsRect) and not IsNullRect(NewCaptionRect)
then
begin
OffsetY := NewCaptionRect.Top;
if not NewButtonsInLeft
then
begin
OffsetX := NewCaptionRect.Right;
SetStdObjectsRect;
end
else
begin
OffsetX := NewCaptionRect.Left;
SetStdObjectsRect2;
end;
end
else
if not IsNullRect(NewButtonsRect)
then
begin
OffsetY := NewButtonsRect.Top;
if not NewButtonsInLeft
then
begin
OffsetX := NewButtonsRect.Right;
SetStdObjectsRect;
end
else
begin
OffsetX := NewButtonsRect.Left;
SetStdObjectsRect2;
end;
end;
//
end;
procedure TspDynamicSkinForm.PaintBG2(DC: HDC);
var
C: TCanvas;
X, Y, XCnt, YCnt: Integer;
B: TBitMap;
begin
if (FSD = nil) or FSD.Empty then Exit;
C := TCanvas.Create;
C.Handle := DC;
B := TBitMap(FSD.FActivePictures.Items[FSD.BGPictureIndex]);
if (FForm.ClientWidth > 0) and (FForm.ClientHeight > 0)
then
begin
XCnt := FForm.ClientWidth div B.Width;
YCnt := FForm.ClientHeight div B.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * B.Width, Y * B.Height, B);
end;
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
C.Free;
end;
procedure TspDynamicSkinForm.PaintBG3(DC: HDC);
var
C: TCanvas;
X, Y, XCnt, YCnt: Integer;
B: TBitMap;
begin
if (FSD = nil) or FSD.Empty then Exit;
C := TCanvas.Create;
C.Handle := DC;
B := TBitMap(FSD.FActivePictures.Items[FSD.MDIBGPictureIndex]);
if (FForm.ClientWidth > 0) and (FForm.ClientHeight > 0)
then
begin
XCnt := FForm.ClientWidth div B.Width;
YCnt := FForm.ClientHeight div B.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * B.Width, Y * B.Height, B);
end;
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
C.Free;
end;
procedure TspDynamicSkinForm.PaintBG(DC: HDC);
var
C: TCanvas;
X, Y, XCnt, YCnt, w, h,
rw, rh, XO, YO: Integer;
BGImage: TBitMap;
R: TRect;
begin
if (FSD = nil) or FSD.Empty then Exit;
C := TCanvas.Create;
C.Handle := DC;
if IsNullRect(FSD.ClRect)
then
begin
with C do
begin
Brush.Color := clBtnFace;
R := FForm.ClientRect;
FillRect(R);
end;
C.Free;
Exit;
end;
BGImage := TBitMap.Create;
if (FForm.ClientWidth > 0) and (FForm.ClientHeight > 0)
then
begin
BGImage.Width := FForm.ClientWidth;
BGImage.Height := FForm.ClientHeight;
w := RectWidth(FSD.ClRect);
h := RectHeight(FSD.ClRect);
rw := BGImage.Width;
rh := BGImage.Height;
with BGImage.Canvas do
begin
XCnt := rw div w;
YCnt := rh div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > rw then XO := X * W + W - rw else XO := 0;
if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
CopyRect(Rect(X * w, Y * h,X * w + w - XO, Y * h + h - YO),
FSD.FPicture.Canvas,
Rect(FSD.ClRect.Left, FSD.ClRect.Top,
FSD.ClRect.Right - XO, FSD.ClRect.Bottom - YO));
end;
end;
end;
if not FLogoBitMap.Empty then DrawLogoBitMap(BGImage.Canvas);
C.Draw(0, 0, BGImage);
BGImage.Free;
C.Free;
end;
procedure TspDynamicSkinForm.Paint;
var
i: Integer;
Canvas: TCanvas;
R: TRect;
PW, PH: Integer;
RealPicture: TBitMap;
begin
if FFormWidth = 0 then FFormWidth := FForm.Width;
if FFormheight = 0 then FFormHeight := FForm.Height;
Canvas := TCanvas.Create;
Canvas.Handle := DC;
RealPicture := TBitMap.Create;
if (FSD = nil) or (FSD.Empty)
then
begin
R := FForm.ClientRect;
with Canvas do
begin
Brush.Color := clBtnFace;
Pen.Color := clBlack;
Rectangle(R.Left, R.Top, R.Right, R.Bottom);
end;
Canvas.Free;
Exit;
end;
with Canvas do
begin
if FRollUpState and not FSD.FRollUpPicture.Empty
then
begin
with FSD do
begin
PW := FRollUpPicture.Width;
PH := FRollUpPicture.Height;
if RollUpRightPoint.X > RollUpLeftPoint.X
then
begin
CreateHSkinImage(
RollUpLeftPoint.X, PW - RollUpRightPoint.X,
RealPicture, FRollUpPicture,
Rect(0, 0, PW, PH), FForm.Width, PH);
end
else
begin
RealPicture.Width := PW;
RealPicture.Height := PH;
RealPicture.Canvas.Draw(0, 0, FSD.FRollUpPicture);
end;
end;
end
else
if (FSD.LTPoint.X = 0) and (FSD.LTPoint.Y = 0)
and
(FSD.RBPoint.X = 0) and (FSD.RBPoint.Y = 0)
then
begin
RealPicture.Width := FSD.FPicture.Width;
RealPicture.Height := FSD.FPicture.Height;
RealPicture.Canvas.Draw(0, 0, FSD.FPicture);
end
else
begin
CreateRealBitMap(RealPicture, FSD.FPicture);
end;
for i := 0 to ObjectList.Count - 1 do
with TspActiveSkinObject(ObjectList.Items[i]) do
begin
if (not RollUp and not FRollUpState) or (RollUp and FRollUpState)
then
Draw(RealPicture.Canvas, False);
end;
Draw(0, 0, RealPicture);
end;
RealPicture.Free;
Canvas.Free;
end;
function TspDynamicSkinForm.NewDefNCHitTest;
const
Offset = 2;
var
CR: TRect;
begin
if (FWindowState = wsMaximized) or FRollUpState or not FSizeAble or
(FWindowState = wsMinimized)
then
with FForm do
begin
CR := GetDefCaptionRect;
if PtInRect(CR, P)
then
Result := HTCAPTION
else
if PtInRect(Rect(3, GetDefCaptionHeight + 3, Width - 3, Height - 3), P)
then
Result := HTCLIENT
else
Result := HTNCACTIVE;
end
else
if (ActiveObject <> -1)
then
begin
Result := HTNCACTIVE;
end
else
with FForm do
if (P.X <= Offset) and (P.Y <= Offset)
then
Result := HTTOPLEFT
else
if (P.X >= Width - Offset) and (P.Y <= Offset)
then
Result := HTTOPRIGHT
else
if (P.X <= Offset) and (P.Y >= Height - Offset)
then
Result := HTBOTTOMLEFT
else
if (P.X >= Width - Offset) and (P.Y >= Height - Offset)
then
Result := HTBOTTOMRIGHT
else
if (P.X <= Offset)
then
Result := HTLEFT
else
if (P.Y <= Offset)
then
Result := HTTOP
else
if (P.X >= Width - Offset)
then
Result := HTRIGHT
else
if (P.Y >= Height - Offset)
then
Result := HTBOTTOM
else
begin
CR := GetDefCaptionRect;
if PtInRect(CR, P)
then
Result := HTCAPTION
else
if PtInRect(Rect(3, GetDefCaptionHeight + 3, Width - 3, Height - 3), P)
then
Result := HTCLIENT
else
Result := HTNCACTIVE;
end
end;
function TspDynamicSkinForm.NewNCHitTest(P: TPoint): Integer;
var
LP, TP, RP, BP: TPoint;
CR: TRect;
BW: Integer;
function InCaption: Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject
then
with TspSkinCaptionObject(ObjectList.Items[i]) do
if CanObjectTest(RollUp) and PtInRect(ObjectRect, P)
then
begin
Result := True;
Break;
end;
end;
function CanHit: Boolean;
begin
if FSD.FMask.Empty
then
begin
Result := not (PtInRect(CR, LP) and PtInRect(CR, TP) and
PtInRect(CR, RP) and PtInRect(CR, BP));
end
else
Result := not PtInRect(NewMaskRectArea, P) and
not (PtInMask(LP) and PtInMask(TP) and
PtInMask(RP) and PtInMask(BP));
end;
begin
if FRollUpState or (WindowState = wsMinimized)
then
begin
if InCaption
then Result := HTCAPTION
else Result := HTNCACTIVE;
end
else
if (ActiveObject <> -1) and not InCaption and not PtInRect(NewClRect, P) and
not FSizeMove
then
begin
Result := HTNCACTIVE;
end
else
if (WindowState = wsMaximized) or not FSizeAble
then
begin
if PtInRect(NewClRect, P)
then
Result := HTCLIENT
else
if InCaption
then Result := HTCAPTION
else Result := HTNCACTIVE;
end
else
begin
BW := FSD.BorderW;
LP := Point(P.X - BW, P.Y);
TP := Point(P.X, P.Y - BW);
RP := Point(P.X + BW, P.Y);
BP := Point(P.X, P.Y + BW);
CR := Rect(0, 0, FForm.Width, FForm.Height);
if CanHit
then
begin
if (P.X <= NewHitTestLtPoint.X) and (P.Y <= NewHitTestLtPoint.Y)
then
Result := HTTOPLEFT
else
if (P.X >= NewHitTestRTPoint.X) and (P.Y <= NewHitTestRTPoint.Y)
then
Result := HTTOPRIGHT
else
if (P.X <= NewHitTestLBPoint.X) and (P.Y >= NewHitTestLBPoint.Y)
then
Result := HTBOTTOMLEFT
else
if (P.X >= NewHitTestRBPoint.X) and (P.Y >= NewHitTestRBPoint.Y)
then
Result := HTBOTTOMRIGHT
else
if PtInRect(Rect(NewHitTestLTPoint.X, 0,
NewHitTestRTPoint.X, NewClRect.Top), P)
then
Result := HTTOP
else
if PtInRect(Rect(NewHitTestLBPoint.X, NewClRect.Bottom,
NewHitTestRBPoint.X, CR.Bottom), P)
then
Result := HTBOTTOM
else
if PtInRect(Rect(0, NewHitTestLTPoint.Y,
NewCLRect.Left, NewHitTestLBPoint.Y), P)
then
Result := HTLEFT
else
if PtInRect(Rect(NewClRect.Right, NewHitTestRTPoint.Y,
CR.Right, NewHitTestRBPoint.Y), P)
then
Result := HTRIGHT
else
if PtInRect(NewClRect, P)
then
Result := HTCLIENT
else
if InCaption
then Result := HTCAPTION
else Result := HTNCACTIVE;
end
else
if PtInRect(NewClRect, P)
then
begin
Result := HTCLIENT
end
else
if InCaption
then Result := HTCAPTION
else Result := HTNCACTIVE;
end;
end;
function TspDynamicSkinForm.NewHitTest;
var
LP, TP, RP, BP: TPoint;
CR: TRect;
BW: Integer;
function CanHit: Boolean;
begin
if FSD.FMask.Empty
then
begin
Result := not (PtInRect(CR, LP) and PtInRect(CR, TP) and
PtInRect(CR, RP) and PtInRect(CR, BP));
end
else
Result := not PtInRect(NewMaskRectArea, P) and
not (PtInMask(LP) and PtInMask(TP) and
PtInMask(RP) and PtInMask(BP));
end;
begin
if (not FSizeable or ((WindowState = wsMaximized) or FRollUpState)) or (ActiveObject <> -1)
then
begin
Result := HTCLIENT;
Exit;
end
else
if (FSD <> nil) and not FSD.Empty
then
begin
BW := FSD.BorderW;
LP := Point(P.X - BW, P.Y);
TP := Point(P.X, P.Y - BW);
RP := Point(P.X + BW, P.Y);
BP := Point(P.X, P.Y + BW);
CR := Rect(0, 0, FForm.Width, FForm.Height);
if CanHit
then
begin
if (P.X <= NewHitTestLtPoint.X) and (P.Y <= NewHitTestLtPoint.Y)
then
Result := HTTOPLEFT
else
if (P.X >= NewHitTestRTPoint.X) and (P.Y <= NewHitTestRTPoint.Y)
then
Result := HTTOPRIGHT
else
if (P.X <= NewHitTestLBPoint.X) and (P.Y >= NewHitTestLBPoint.Y)
then
Result := HTBOTTOMLEFT
else
if (P.X >= NewHitTestRBPoint.X) and (P.Y >= NewHitTestRBPoint.Y)
then
Result := HTBOTTOMRIGHT
else
if PtInRect(Rect(NewHitTestLTPoint.X, 0,
NewHitTestRTPoint.X, NewClRect.Top), P)
then
Result := HTTOP
else
if PtInRect(Rect(NewHitTestLBPoint.X, NewClRect.Bottom,
NewHitTestRBPoint.X, CR.Bottom), P)
then
Result := HTBOTTOM
else
if PtInRect(Rect(0, NewHitTestLTPoint.Y,
NewCLRect.Left, NewHitTestLBPoint.Y), P)
then
Result := HTLEFT
else
if PtInRect(Rect(NewClRect.Right, NewHitTestRTPoint.Y,
CR.Right, NewHitTestRBPoint.Y), P)
then
Result := HTRIGHT
else
Result := HTCLIENT;
end
else
Result := HTCLIENT;
end
else
Result := HTCLIENT;
end;
function TspDynamicSkinForm.FindHotKeyItem;
var
i: Integer;
begin
Result := False;
if FMainMenuBar <> nil
then
Result := FMainMenuBar.FindHotKeyItem(CharCode)
else
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(ObjectList.Items[i]) do
begin
if Enabled and Visible and
IsAccel(CharCode, MenuItem.Caption)
then
begin
MouseEnter;
if (not InMenu) or (MenuItem.Count = 0) then MouseDown(0, 0, mbLeft);
Result := True;
Break;
end;
end
end;
function TspDynamicSkinForm.CanNextMainMenuItem;
var
PW: TspSkinPopupWindow;
begin
if SkinMenu.FPopupList.Count = 0
then
Result := True
else
with SkinMenu do
begin
PW := TspSkinPopupWindow(FPopupList.Items[FPopupList.Count - 1]);
if PW.ActiveItem <> -1
then
begin
if TspSkinMenuItem(PW.ItemList[PW.ActiveItem]).MenuItem.Count = 0
then
Result := True
else
Result := False;
end
else
Result := True
end;
end;
function TspDynamicSkinForm.CanPriorMainMenuItem;
begin
if SkinMenu.FPopupList.Count < 2 then Result := True else Result := False;
end;
procedure TspDynamicSkinForm.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 TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(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 TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(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
TspSkinMainMenuItem(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 TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
MouseEnter;
Break;
end;
end;
end;
end;
procedure TspDynamicSkinForm.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 TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(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 TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(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
TspSkinMainMenuItem(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 TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
MouseEnter;
Break;
end;
end;
end;
end;
procedure TspDynamicSkinForm.ActivateMenu;
var
i: Integer;
FirstItem: Integer;
begin
FirstItem := -1;
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(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
TspSkinMainMenuItem(ObjectList.Items[FirstItem]).MouseEnter;
InMainMenu := True;
HookApp;
end;
if Assigned(FOnMainMenuEnter) then FOnMainMenuEnter(Self);
end;
function TspDynamicSkinForm.CheckReturnKey;
var
i: Integer;
begin
Result := False;
if FMainMenuBar <> nil
then
Result := FMainMenuBar.CheckReturnKey
else
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinMainMenuItem
then
with TspSkinMainMenuItem(ObjectList.Items[i]) do
begin
if (FDown and (MenuItem.Count = 0)) or
(Active and not InMenu)
then
begin
Active := False;
MouseDown(0, 0, mbLeft);
Result := True;
Break;
end;
end;
end;
procedure TspDynamicSkinForm.FormClientWindowProcHook(var Message: TMessage);
var
FOld: Boolean;
R: TRect;
begin
FOld := True;
case Message.Msg of
WM_NCACTIVATE:
begin
FOld := False;
Message.Result := 1;
end;
WM_NCCALCSIZE:
begin
FOLd := False;
end;
WM_SIZE:
begin
Message.Result := CallWindowProc(FPrevClientProc, FForm.ClientHandle, Message.Msg,
Message.wParam, Message.lParam);
ResizeMDIChilds;
R := Rect(0, 0, FForm.ClientWidth, FForm.ClientHeight);
if not FLogoBitMap.Empty
then
ReDrawWindow(FForm.ClientHandle, @R, 0, RDW_ERASE or RDW_INVALIDATE);
FOld := False;
end;
WM_NCPAINT:
begin
FOld := False;
end;
WM_ERASEBKGND:
begin
FOld := False;
if (FSD <> nil) and not FSD.Empty
then
begin
if FSD.MDIBGPictureIndex <> -1
then
PaintBG3(TWMERASEBKGND(Message).DC)
else
if FSD.BGPictureIndex = -1
then
PaintBG(TWMERASEBKGND(Message).DC)
else
PaintBG2(TWMERASEBKGND(Message).DC);
end
else
PaintMDIBGDefault(TWMERASEBKGND(Message).DC);
end;
end;
if FOld
then
with Message do
Result := CallWindowProc(FPrevClientProc, FForm.ClientHandle, Msg,
wParam, lParam);
end;
procedure TspDynamicSkinForm.FormKeyDown(Message: TMessage);
var
DSF: TspDynamicSkinForm;
begin
if (FForm.FormStyle = fsMDIChild)
then
begin
DSF := GetDynamicSkinFormComponent(Application.MainForm);
if DSF <> nil
then
begin
if DSF.InMenu or DSF.InMainMenu or DSF.SkinMenu.Visible
then
begin
DSF.FormKeyDown(Message);
Exit;
end;
end;
end;
if InMainMenu and FindHotKeyItem(TWMKeyDown(Message).CharCode)
then
begin
end
else
if (TWMKeyDown(Message).CharCode = VK_ESCAPE) and
(InMainMenu and not InMenu)
then
SkinMainMenuClose
else
if (TWMKeyDown(Message).CharCode = VK_LEFT) and InMainMenu and
CanPriorMainMenuItem
then
begin
if FMainMenuBar <> nil
then FMainMenuBar.PriorMainMenuItem
else PriorMainMenuItem;
end
else
if (TWMKeyDown(Message).CharCode = VK_RIGHT) and InMainMenu and
CanNextMainMenuItem
then
begin
if FMainMenuBar <> nil
then FMainMenuBar.NextMainMenuItem
else NextMainMenuItem;
end
else
if TWMKeyDown(Message).CharCode = VK_RETURN
then
begin
if not CheckReturnKey
then
with TWMKeyDown(Message), SkinMenu do
begin
if Visible and (FPopupList.Count > 0)
then
TspSkinPopupWindow(FPopupList.Items[FPopupList.Count - 1]).PopupKeyDown(CharCode);
end;
end
else
with TWMKeyDown(Message), SkinMenu do
begin
if Visible and (FPopupList.Count > 0)
then
TspSkinPopupWindow(FPopupList.Items[FPopupList.Count - 1]).PopupKeyDown(CharCode);
if (CharCode = VK_ESCAPE) and (FPopupList.Count = 0)
then
if InMainMenu
then
SkinMenuClose2
else
SkinMenuClose;
end;
end;
procedure TspDynamicSkinForm.NewAppMessage;
var
MsgNew: TMessage;
begin
MsgNew.WParam := Msg.WParam;
MsgNew.LParam := Msg.LParam;
MsgNew.Msg := Msg.message;
case Msg.message of
WM_MOUSEWHEEL:
begin
Msg.message := 0;
Handled := True;
end;
WM_KEYDOWN:
begin
FormKeyDown(MsgNew);
Msg.message := 0;
Handled := True;
end;
end;
end;
procedure TspDynamicSkinForm.CheckMenuVisible;
var
DS: TspDynamicSkinForm;
begin
if CanMenuClose(Msg)
then
begin
// hide object hint
if FShowObjectHint and (FSkinHint <> nil)
then FSkinHint.HideHint;
//
if InMainMenu and not InMenu
then
SkinMainMenuClose
else
if (SkinMenu <> nil) and (SkinMenu.Visible or (InMenu))
then
begin
if SkinMenu.Visible
then SkinMenu.Hide
else SkinMenuClose;
end
else
if (FForm.FormStyle = fsMDIForm) and FForm.Visible
then
begin
DS := GetMDIChildDynamicSkinFormComponent2;
if DS <> nil then DS.CheckMenuVisible(Msg);
end;
end;
end;
procedure TspDynamicSkinForm.NewWndProc(var Message: TMessage);
const
WM_SYNCPAINT = $0088;
var
MM: PMINMAXINFO;
Old: boolean;
P: TPoint;
CS: Boolean;
L, T, i, j: Integer;
B: Boolean;
R: PRect;
R1: TRect;
begin
CheckMenuVisible(Message.Msg);
Old := True;
with Message do
begin
case Msg of
WM_MOUSEACTIVATE:
if (FForm.FormStyle = fsMDIChild)
then
begin
if (Application.MainForm.ActiveMDIChild = FForm) and not FFormActive
then
begin
FFormActive := True;
if FWindowState = wsMaximized
then FormChangeActive(False)
else FormChangeActive(True);
end;
end;
WM_SETTEXT:
begin
OldWindowProc(Message);
if (FForm.BorderStyle <> bsNone) and
not ((FForm.FormStyle = fsMDICHILD) and (WindowState = wsMaximized))
then
if FSkinSupport
then
begin
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
SetDefaultCaptionText(FForm.Caption)
end
else
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
if FForm.FormStyle = fsMDIChild
then
begin
UpDateChildCaptionInMenu(FForm);
RefreshMDIBarTab(FForm);
end;
Old := False;
end;
WM_MDICHILDMAX:
if FForm.FormStyle = fsMDIForm
then
begin
FMDIChildMaximized := True;
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
if FMainMenuBar <> nil then FMainMenuBar.MDIChildMaximize;
end;
WM_MDICHILDRESTORE:
if FForm.FormStyle = fsMDIForm
then
begin
if GetMaximizeMDIChild = nil then FMDIChildMaximized := False;
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
if FMainMenuBar <> nil then FMainMenuBar.MDIChildRestore;
end;
WM_MDICHANGESIZE:
if (FForm.FormStyle = fsMDICHILD) and (FWindowState = wsMaximized)
then
begin
R1 := GetMDIWorkArea;
FForm.SetBounds(0, 0, RectWidth(R1), RectHeight(R1));
end;
WM_SYSCOMMAND:
begin
if Message.WParam = SC_KEYMENU
then
begin
if not InMainMenu then
begin
if SkinMenu.Visible then SkinMenuClose;
if FMainMenuBar <> nil
then FMainMenuBar.MenuEnter
else ActivateMenu;
end
else
if InMainMenu
then
SkinMainMenuClose;
Old := False;
end;
end;
WM_CLOSESKINMENU:
begin
SkinMenuClose;
end;
WM_TIMER:
if (Message.WParam = 1) and CheckW2KWXP and (FAlphaBlend or FAlphaBlendAnimation)
then
begin
KillTimer(FForm.Handle, 1);
if FAlphaBlendAnimation and not FAlphaBlend
then J := 255 else J := FAlphaBlendValue;
if FAlphaBlendAnimation
then
begin
I := 0;
Application.ProcessMessages;
repeat
Inc(i, 5);
if I > J then I := J;
SetAlphaBlendTransparent(FForm.Handle, i);
until i >= J;
end
else
if J <> 255
then
SetAlphaBlendTransparent(FForm.Handle, FAlphaBlendValue);
if J = 255
then
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;
WM_SHOWWINDOW:
begin
if Message.wParam > 0
then
begin
//
if CheckW2KWXP and (FAlphaBlend or FAlphaBlendAnimation)
then
begin
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetAlphaBlendTransparent(FForm.Handle, 0);
SetTimer(FForm.Handle, 1, 1, nil);
end;
//
if (FForm.FormStyle <> fsMDIForm) and FSupportNCArea
then
UpdateForm
else
if (FForm.FormStyle = fsMDIForm) and (FForm.ClientHandle <> 0) and
(FClientInstance = nil)
then
begin
FPrevClientProc := Pointer(GetWindowLong(FForm.ClientHandle, GWL_WNDPROC));
FClientInstance := MakeObjectInstance(FormClientWindowProcHook);
SetWindowLong(FForm.ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
UpDateForm;
end;
if FForm.FormStyle = fsMDIChild
then
begin
AddChildToMenu(FForm);
AddChildToBar(FForm);
end;
if not FSupportNCArea then ControlsToAreas;
if FForm.Menu <> nil then FForm.Menu := nil;
end
else
begin
if FForm.FormStyle = fsMDIChild
then
begin
DeleteChildFromMenu(FForm);
DeleteChildFromBar(FForm);
end;
if CheckW2KWXP and FAlphaBlend
then
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;
end;
WM_NCHITTEST:
if FSupportNCArea
then
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
if FSkinSupport
then
Result := NewNCHitTest(P)
else
Result := NewDefNCHitTest(P);
if not MouseTimer.Enabled and (Message.Result = HTNCACTIVE)
then
begin
TestActive(P.X, P.Y, True);
MouseTimer.Enabled := True;
end;
Old := False;
end
else
if FSkinSupport
then
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
P := FForm.ScreenToClient(P);
if not MouseIn
then
begin
MouseIn := True;
TestActive(P.X, P.Y, True);
MouseTimer.Enabled := True;
end;
Result := NewHitTest(P);
Old := False;
end
else
Result := HTCLIENT;
WM_BEFORECHANGESKINDATA:
if WParam = Integer(FSD)
then
begin
FSkinSupport := False;
MouseTimer.Enabled := False;
MorphTimer.Enabled := False;
AnimateTimer.Enabled := False;
ClearObjects;
BeforeUpDateSkinControls(WParam, FForm);
end;
WM_AFTERCHANGESKINDATA:
begin
if (WParam = Integer(FSD)) and (FForm.FormStyle = fsMDIForm)
then
begin
ResizeMDIChilds;
end;
end;
WM_CHANGESKINDATA:
begin
if WParam = Integer(FSD)
then
ChangeSkinData;
UpDateSkinControls(WParam, FForm);
end;
WM_MOVING:
if (WindowState = wsMaximized) and (FForm.FormStyle <> fsMDIChild)
then
begin
L := FForm.Left;
T := FForm.Top;
PRect(Message.LParam)^.Left := L;
PRect(Message.LParam)^.Top := T;
PRect(Message.LParam)^.Right := L + FForm.Width;
PRect(Message.LParam)^.Bottom := T + FForm.Height;
end
else
if FMagnetic
then
begin
L := PRect(Message.LParam)^.Left;
T := PRect(Message.LParam)^.Top;
DoMagnetic(L, T, FForm.Width, FForm.Height);
PRect(Message.LParam)^.Left := L;
PRect(Message.LParam)^.Top := T;
PRect(Message.LParam)^.Right := L + FForm.Width;
PRect(Message.LParam)^.Bottom := T + FForm.Height;
end;
WM_ENTERSIZEMOVE:
if FSupportNCArea
then
begin
UpDateActiveObjects;
MouseTimer.Enabled := False;
ActiveObject := -1;
MouseCaptureObject := -1;
FSizeMove := True;
FFullDrag := GetFullDragg;
end;
WM_EXITSIZEMOVE:
if FSupportNCArea
then
begin
MouseTimer.Enabled := False;
ActiveObject := -1;
OldActiveObject := -1;
MouseCaptureObject := -1;
// FSizeMove := False;
if FSupportNCArea and (FSD <> nil) and not FSD.Empty
then
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
WM_SIZING:
if FSizeMove and FFullDrag
then
begin
OldWindowProc(Message);
Old := False;
R := PRect(LParam);
FFormWidth := RectWidth(R^);
FFormHeight := RectHeight(R^);
if FSupportNCArea
then
begin
if (FSD <> nil) and
(FForm.Width >= GetMinWidth) and
(FForm.Height >= GetMinHeight)
then
CreateNewForm(True);
end;
end;
WM_SIZE:
if not FSizeMove or not FFullDrag
then
begin
OldWindowProc(Message);
Old := False;
FFormWidth := FForm.Width;
FFormHeight := FForm.Height;
if not FSkinSupport
then
begin
if FSupportNCArea
then
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end
else
if FSupportNCArea
then
begin
if (FSD <> nil) and
(FFormWidth >= GetMinWidth) and
(FFormHeight >= GetMinHeight)
then
CreateNewForm(True);
end
else
begin
if (FSD <> nil) and not FRollUpState
then
begin
CS := CanScale;
if CS or (not CS and (FForm.ClientWidth = FSD.FPicture.Width)
and (FForm.ClientHeight = FSD.FPicture.Height))
then CreateNewForm(CS);
end;
end;
if FAlphaBlend and (FAlphaBlendValue <> 255) and CheckW2KWXP and
FSupportNCArea
then
begin
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
FForm.RePaint;
end;
if FSupportNCArea and not FLogoBitMap.Empty and (FForm.FormStyle <> fsMDIForm)
then
FForm.RePaint;
end
else
if FSupportNCArea and not FLogoBitMap.Empty and (FForm.FormStyle <> fsMDIForm)
then
FForm.RePaint;
WM_DESTROY:
begin
MouseTimer.Enabled := False;
MorphTimer.Enabled := False;
AnimateTimer.Enabled := False;
if (FForm.FormStyle = fsMDIChild)
then
begin
FWindowState := wsNormal;
SendMessage(Application.MainForm.Handle, WM_MDICHILDRESTORE, 0, 0);
CheckMDIMainMenu;
CheckMDIBar;
end;
end;
WM_ACTIVATE:
begin
FIsDragging := False;
OldWindowProc(Message);
if FSupportNCArea then SendMessage(FForm.Handle, WM_NCPaint, 0, 0);
if (FForm.FormStyle = fsMDIChild) and (WindowState = wsMaximized)
then
FormChangeActive(False)
else
begin
if FSupportNCArea
then
begin
TestActive(-1, -1, False);
UpDateActiveObjects;
end;
FormChangeActive(True);
end;
Old := False;
if FForm.FormStyle = fsMDIForm then Self.CheckMDIMainMenu;
end;
WM_GetMinMaxInfo:
begin
MM := PMinMaxInfo(lParam);
MM^.ptMinTrackSize.x := GetMinWidth;
MM^.ptMinTrackSize.y := GetMinHeight;
MM^.ptMaxTrackSize.x := GetMaxWidth;
MM^.ptMaxTrackSize.y := GetMaxHeight;
end;
WM_NCCALCSIZE:
begin
Old := False;
if FSupportNCArea and
not ((FForm.FormStyle = fsMDIChild) and
(WindowState = wsMaximized)) and (FForm.BorderStyle <> bsNone)
then
if CanNCSupport
then
begin
CalcRects;
with TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0], FSD do
begin
Inc(Left, ClRect.Left);
Inc(Top, ClRect.Top);
Dec(Right, FPicture.Width - ClRect.Right);
Dec(Bottom, FPicture.Height - ClRect.Bottom);
if Right < Left
then Right := Left;
if Bottom < Top
then Bottom := Top;
end;
end
else
with TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
begin
Inc(Left, 3);
Inc(Top, GetDefCaptionHeight + 3);
Dec(Right, 3);
Dec(Bottom, 3);
if Right < Left then Right := Left;
if Bottom < Top
then Bottom := Top;
end;
end;
WM_SYNCPAINT:
if FRollUpState and FSupportNCArea
then
begin
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
Message.Result := 0;
Old := False;
end;
WM_NCPAINT:
begin
if (FForm.BorderStyle <> bsNone) and
not ((FForm.FormStyle = fsMDICHILD) and (WindowState = wsMaximized))
then
if FSupportNCArea and FSkinSupport
then
PaintNCSkin
else
if FSupportNCArea
then
PaintNCDefault;
Old := False;
end;
WM_NCACTIVATE:
begin
FFormActive := TWMNCACTIVATE(Message).Active;
if (FForm.FormStyle = fsMDIForm) or
(FForm.FormStyle = fsMDIChild)
then
OldWindowProc(Message)
else
Message.Result := 1;
if not ((FForm.FormStyle = fsMDICHILD) and (WindowState = wsMaximized))
and (FForm.BorderStyle <> bsNone)
then
begin
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
FormChangeActive(True);
end
else
FormChangeActive(False);
if (FForm.FormStyle = fsMDIChild) and (WindowState = wsMaximized)
then
begin
Application.MainForm.Perform(WM_NCPAINT, 0, 0);
end;
if FForm.FormStyle = fsMDIChild
then
begin
UpDateChildActiveInMenu;
CheckMDIMainMenu;
CheckMDIBar;
end;
Old := False;
end;
WM_ERASEBKGND:
begin
if FSupportNCArea and (FForm.FormStyle <> fsMDIForm)
then
begin
if FSkinSupport
then
begin
if FSD.BGPictureIndex = -1
then
PaintBG(wParam)
else
PaintBG2(wParam);
end
else
PaintBGDefault(wParam);
end
else
Paint(wParam);
Old := False;
end;
end;
if Old then OldWindowProc(Message);
case Msg of
WM_LBUTTONDBLCLK:
begin
MouseDown(mbLeft, LoWord(LParam), HiWord(LParam));
MouseDblClick;
CheckWindowState;
end;
WM_RBUTTONDBLCLK: MouseDown(mbRight, LoWord(LParam), HiWord(LParam));
WM_MOUSEMOVE:
begin
if not FSupportNCArea
then MouseMove(LoWord(LParam), HiWord(LParam));
end;
WM_LBUTTONDOWN:
begin
if not FSupportNCArea
then MouseDown(mbLeft, LoWord(LParam), HiWord(LParam));
end;
WM_RBUTTONDOWN:
begin
if not FSupportNCArea
then MouseDown(mbRight, LoWord(LParam), HiWord(LParam));
end;
WM_LBUTTONUP:
begin
if not FSupportNCArea
then MouseUp(mbLeft, LoWord(LParam), HiWord(LParam))
else MouseUp(mbLeft, -1, -1);
end;
WM_RBUTTONUP:
begin
if not FSupportNCArea
then MouseUp(mbRight, LoWord(LParam), HiWord(LParam))
else MouseUp(mbRight, -1, -1);
end;
WM_NCMOUSEMOVE:
if FSupportNCArea then
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseMove(P.X, P.Y);
end;
WM_NCLBUTTONDBLCLK:
if FSupportNCArea then
begin
P.X := LoWord(Message.lParam);
P.Y := HiWord(Message.lParam);
PointToNCPoint(P);
TestActive(P.X, P.Y, True);
MouseDown(mbLeft, P.X, P.Y);
MouseDblClick;
if Message.wParam = HTCAPTION
then
if FSizeAble and (WindowState = wsMinimized)
then
begin
WindowState := wsNormal;
MouseCaptureObject := -1;
end
else
if FSizeAble and (WindowState <> wsMaximized) and not FRollUpState and
(biMaximize in BorderIcons)
then
begin
WindowState := wsMaximized;
MouseCaptureObject := -1;
end
else
if FSizeAble and (WindowState = wsMaximized) and not MaxRollUpState
then
begin
WindowState := wsNormal;
MouseCaptureObject := -1;
end
else
begin
if FRollUpState
then
RollUpState := False
else
RollUpState := True;
MouseCaptureObject := -1;
end;
end;
WM_NCRBUTTONDBLCLK:
if FSupportNCArea then
begin
P.X := LoWord(Message.lParam);
P.Y := HiWord(Message.lParam);
PointToNCPoint(P);
TestActive(P.X, P.Y, True);
MouseDown(mbRight, P.X, P.Y);
if wParam = HTCAPTION then MouseCaptureObject := -1;
end;
WM_NCLBUTTONDOWN:
if FSupportNCArea then
begin
if not FSizeMove
then
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
TestActive(P.X, P.Y, True);
MouseDown(mbLeft, P.X, P.Y);
if wParam = HTCAPTION then MouseCaptureObject := -1;
end
else
FSizeMove := False;
end;
WM_NCLBUTTONUP:
if FSupportNCArea
then
begin
try
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseUp(mbLeft, LoWord(LParam), HiWord(LParam));
except
Exit;
end;
end;
WM_NCRBUTTONDOWN:
if FSupportNCArea then
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
TestActive(P.X, P.Y, True);
MouseDown(mbRight, P.X, P.Y);
if wParam = HTCAPTION
then
begin
GetCursorPos(P);
MouseCaptureObject := -1;
TrackSystemMenu(P.X, P.Y);
end;
end;
WM_NCRBUTTONUP:
if FSupportNCArea then
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseUp(mbRight, P.X, P.Y);
end;
end;
end;
end;
procedure TspDynamicSkinForm.CalcRects;
var
OX, OY: Integer;
begin
if FFormWidth = 0 then FFormWidth := FForm.Width;
if FFormHeight = 0 then FFormHeight := FForm.Height;
if (FSD <> nil) and not FSD.Empty then
with FSD do
begin
OX := FFormWidth - FPicture.Width;
OY := FFormHeight - FPicture.Height;
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + OX, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + OY);
NewRBPoint := Point(RBPoint.X + OX, RBPoint.Y + OY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OX, ClRect.Bottom + OY);
NewCaptionRect := CaptionRect;
if not IsNullRect(CaptionRect)
then Inc(NewCaptionRect.Right, OX);
NewButtonsRect := ButtonsRect;
NewButtonsInLeft := CapButtonsInLeft;
if not IsNullRect(ButtonsRect) and (ButtonsRect.Left > FPicture.Width div 2)
then
OffsetRect(NewButtonsRect, OX, 0)
else
if not IsNullRect(ButtonsRect) and (ButtonsRect.Left < FPicture.Width div 2)
then
ButtonsInLeft := True;
NewButtonsOffset := ButtonsOffset;
NewHitTestLTPoint := HitTestLTPoint;
NewHitTestRTPoint := Point(HitTestRTPoint.X + OX, HitTestRTPoint.Y);
NewHitTestLBPoint := Point(HitTestLBPoint.X, LBPoint.Y + OY);
NewHitTestRBPoint := Point(HitTestRBPoint.X + OX, HitTestRBPoint.Y + OY);
NewMaskRectArea := Rect(MaskRectArea.Left, MaskRectArea.Top,
MaskRectArea.Right + OX, MaskRectArea.Bottom + OY);
NewIconRect := Self.CalcRealObjectRect(IconRect);
NewMainMenuRect := MainMenuRect;
if CanScale
then
begin
NewMainMenuRect.Right := MainMenuRect.Right + OX;
if PtInRect(Rect(0, LBPoint.Y, LBPoint.X,
FPicture.Height), MainMenuRect.TopLeft)
then
OffsetRect(NewMainMenuRect, 0, OY);
end;
end;
end;
procedure TspDynamicSkinForm.CreateNewForm;
begin
if csDesigning in ComponentState then Exit;
if FSD = nil then Exit;
if FSD.Empty then Exit;
CalcRects;
if FCanScale then CalcAllRealObjectRect;
CreateNewRegion(FCanScale);
if Assigned(FOnChangeClientRect) then FOnChangeClientRect(NewClRect);
if FSupportNCArea
then
begin
if FRgn = 0
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end
else
begin
FForm.RePaint;
ControlsToAreas;
end;
end;
procedure TspDynamicSkinForm.CreateNewRegion;
var
Size: Integer;
RgnData: PRgnData;
R1, R2, R3, R4, TempRgn: HRGN;
begin
if (FForm.BorderStyle = bsNone) and FSupportNCArea
then
begin
if FRgn <> 0
then
begin
SetWindowRgn(FForm.Handle, 0, True);
DeleteObject(FRgn);
FRgn := 0;
end;
end
else
if (FForm.FormStyle = fsMDIChild) and (WindowState = wsMaximized) and not FSD.FMask.Empty
then
begin
if FRgn <> 0
then
begin
SetWindowRgn(FForm.Handle, 0, True);
DeleteObject(FRgn);
FRgn := 0;
end;
end
else
if ((FSD = nil) or ((FSD <> nil) and (FSD.FMask.Empty))) and (FRgn <> 0)
then
begin
SetWindowRgn(FForm.Handle, 0, True);
DeleteObject(FRgn);
FRgn := 0;
RMLeft.Assign(nil);
RMTop.Assign(nil);
RMRight.Assign(nil);
RMBottom.Assign(nil);
end
else
if (FSD <> nil) and not FSD.FMask.Empty
then
begin
if FCanScale
then
begin
CreateSkinMask(
FSD.LTPoint, FSD.RTPoint, FSD.LBPoint, FSD.RBPoint, FSD.MaskRectArea,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewMaskRectArea,
FSD.FMask, RMTop, RMLeft, RMRight, RMBottom,
FFormWidth, FFormHeight);
if RMTop.Height > 0
then
begin
Size := CreateRgnFromBmp(RMTop, 0, 0, RgnData);
R1 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R1 := 0;
if RMBottom.Height > 0
then
begin
Size := CreateRgnFromBmp(RMBottom, 0, NewMaskRectArea.Bottom, RgnData);
R2 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R2 := 0;
if RMLeft.Width > 0
then
begin
Size := CreateRgnFromBmp(RMLeft, 0, NewMaskRectArea.Top, RgnData);
R3 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R3 := 0;
if RMRight.Width > 0
then
begin
Size := CreateRgnFromBmp(RMRight, NewMaskRectArea.Right, NewMaskRectArea.Top, RgnData);
R4 := ExtCreateRegion(nil, Size, RgnData^);
FreeMem(RgnData, Size);
end
else
R4 := 0;
TempRgn := FRgn;
FRgn := CreateRectRgn(NewMaskRectArea.Left, NewMaskRectArea.Top,
NewMaskRectArea.Right, NewMaskRectArea.Bottom);
CombineRgn(R1, R1, R2, RGN_OR);
CombineRgn(R3, R3, R4, RGN_OR);
CombineRgn(R3, R3, R1, RGN_OR);
CombineRgn(FRgn, FRgn, R3, RGN_OR);
SetWindowRgn(FForm.Handle, FRgn, True);
if TempRgn <> 0 then DeleteObject(TempRgn);
DeleteObject(R1);
DeleteObject(R2);
DeleteObject(R3);
DeleteObject(R4);
end
else
begin
Size := CreateRgnFromBmp(FSD.FMask, 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;
end;
function TspDynamicSkinForm.GetFormActive;
begin
if (FForm.FormStyle = fsMDIChild) or (FForm.FormStyle = fsMDIForm)
then
Result := FFormActive
else
Result := FForm.Active and (Screen.ActiveCustomForm = FForm);
end;
procedure TspDynamicSkinForm.FormChangeActive;
var
i: Integer;
FA: Boolean;
begin
FA := GetFormActive;
for i := 0 to ObjectList.Count - 1 do
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject
then
with TspSkinCaptionObject(ObjectList.Items[i]) do
begin
if AUpDate and CanObjectTest(RollUp)
then
begin
if not FSupportNCArea then Active := FA;
if not (FSupportNCArea and IsNullRect(ActiveSkinRect))
then
ReDraw;
end
else
if Morphing then
if FA then MorphKf := 1 else MorphKf := 0;
end;
if FA
then
begin
if Assigned(FOnActivate) then FOnActivate(Self);
end
else
begin
if Assigned(FOnDeActivate) then FOnDeActivate(Self);
end;
end;
procedure TspDynamicSkinForm.SetEnabled;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> -1
then
TspActiveSkinObject(ObjectList.Items[i]).Enabled := Value;
end;
procedure TspDynamicSkinForm.SwitchSetState;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinSwitchObject
then
with TspSkinSwitchObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SimpleSetState(AState)
else State := AState;
end;
function TspDynamicSkinForm.SwitchGetState;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1
then
begin
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinSwitchObject
then
with TspSkinSwitchObject(ObjectList.Items[i]) do Result := State
else
Result := swsOff;
end
else
Result := swsOff;
end;
procedure TspDynamicSkinForm.CaptionSetText;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if TspActiveSkinObject(ObjectList.Items[i]) is TspSkinCaptionObject
then
with TspSkinCaptionObject(ObjectList.Items[i]) do
if FInChangeSkinData
then SimpleSetTextValue(AText)
else TextValue := AText;
end;
function TspDynamicSkinForm.ButtonGetDown;
var
i: Integer;
begin
i := GetIndex(AIDName);
if (i <> -1) and (TspActiveSkinObject(ObjectList.Items[i]) is TspSkinButtonObject)
then
Result := TspSkinButtonObject(ObjectList.Items[i]).Down
else
Result := False;
end;
procedure TspDynamicSkinForm.ButtonSetDown;
var
i: Integer;
begin
i := GetIndex(AIDName);
if (i <> -1) and (TspActiveSkinObject(ObjectList.Items[i]) is TspSkinButtonObject)
then TspSkinButtonObject(ObjectList.Items[i]).Down := ADown;
end;
// TspMDITabsBar
constructor TspMDITab.Create;
begin
TabsBar := AParentBar;
Child := AChild;
ObjectRect := NullRect;
Active := False;
MouseIn := False;
end;
procedure TspMDITab.Draw(Cnvs: TCanvas);
var
TB: TBitMap;
R: TRect;
S: String;
FC: TColor;
W, H: Integer;
begin
if RectWidth(ObjectRect) < 1 then Exit;
TB := TBitMap.Create;
TB.Width := RectWidth(ObjectRect);
TB.Height := RectHeight(ObjectRect);
W := TB.Width;
H := TB.Height;
if TabsBar.FIndex <> -1
then
begin
if MouseIn and not Active
then
begin
CreateHSkinImage(TabsBar.TabLeftOffset, TabsBar.TabRightOffset,
TB, TabsBar.Picture, TabsBar.MouseInTabRect, W, H);
FC := TabsBar.MouseInFontColor;
end
else
if Active
then
begin
CreateHSkinImage(TabsBar.TabLeftOffset, TabsBar.TabRightOffset,
TB, TabsBar.Picture, TabsBar.ActiveTabRect, W, H);
FC := TabsBar.ActiveFontColor;
end
else
begin
CreateHSkinImage(TabsBar.TabLeftOffset, TabsBar.TabRightOffset,
TB, TabsBar.Picture, TabsBar.TabRect, W, H);
FC := TabsBar.FontColor;
end;
with TB.Canvas.Font do
begin
Name := TabsBar.FontName;
Style := TabsBar.FontStyle;
Height := TabsBar.FontHeight;
CharSet := TabsBar.DefaultFont.CharSet;
Color := FC;
end;
R := Rect(TabsBar.TabLeftOffset, 0, TB.Width - TabsBar.TabRightOffset, TB.Height);
S := Child.Caption;
CorrectTextbyWidth(TB.Canvas, S, RectWidth(R));
TB.Canvas.Brush.Style := bsClear;
DrawText(TB.Canvas.Handle, PChar(S), Length(S), R,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end
else
with TB.Canvas do
begin
if MouseIn and not Active
then
Brush.Color := SP_XP_BTNACTIVECOLOR
else
if Active
then
Brush.Color := SP_XP_BTNDOWNCOLOR
else
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, TB.Width, TB.Height));
Brush.Style := bsClear;
Font.Assign(TabsBar.DefaultFont);
R := Rect(2, 0, TB.Width - 2, TB.Height);
S := Child.Caption;
CorrectTextbyWidth(TB.Canvas,S, RectWidth(R));
DrawText(TB.Canvas.Handle, PChar(S), Length(S), R,
DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;
Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, TB);
TB.Free;
end;
constructor TspSkinMDITabsBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDefaultHeight := 21;
Height := 21;
Width := 150;
SkinDataName := 'tab';
FDefaultFont := TFont.Create;
FDefaultTabWidth := 100;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
ObjectList := TList.Create;
ActiveTabIndex := -1;
OldTabIndex := -1;
end;
destructor TspSkinMDITabsBar.Destroy;
begin
ClearObjects;
ObjectList.Free;
FDefaultFont.Free;
inherited;
end;
procedure TspSkinMDITabsBar.CheckActive;
var
I: Integer;
F: TCustomForm;
begin
F := Application.MainForm.ActiveMDIChild;
if F = nil then Exit;
for I := 0 to ObjectList.Count - 1 do
with TspMDITab(ObjectList.Items[I]) do
begin
Active := (Child = F);
end;
RePaint;
end;
procedure TspSkinMDITabsBar.MouseMove;
begin
inherited;
TestActive(X, Y);
end;
procedure TspSkinMDITabsBar.MouseDown;
var
Tab: TspMDITab;
begin
inherited;
if Button = mbLeft
then
begin
Tab := GetTab(X, Y);
if Tab <> nil then Tab.Child.Show;
end;
end;
procedure TspSkinMDITabsBar.CMMouseLeave;
begin
inherited;
TestActive(-1, -1);
end;
function TspSkinMDITabsBar.GetTabIndex;
var
I: Integer;
R: TRect;
begin
Result := -1;
if ObjectList.Count > 0
then
for I := 0 to ObjectList.Count - 1 do
begin
R := TspMDITab(ObjectList.Items[I]).ObjectRect;
if (X >= R.Left) and (X <= R.Right) and
(Y >= R.Top) and (Y <= R.Bottom)
then
begin
Result := I;
Break;
end;
end;
end;
function TspSkinMDITabsBar.GetTab;
var
I: Integer;
begin
I := GetTabIndex(X, Y);
if I <> -1
then
Result := TspMDITab(ObjectList.Items[I])
else
Result := nil;
end;
procedure TspSkinMDITabsBar.TestActive;
var
Tab: TspMDITab;
begin
ActiveTabIndex := GetTabIndex(X, Y);
if (ActiveTabIndex <> OldTabIndex)
then
begin
if OldTabIndex <> -1
then
with TspMDITab(ObjectList.Items[OldTabIndex]) do
begin
MouseIn := False;
Draw(Canvas);
if Assigned(FOnTabMouseLeave)
then
FOnTabMouseLeave(TspMDITab(ObjectList.Items[OldTabIndex]));
end;
if ActiveTabIndex <> -1
then
with TspMDITab(ObjectList.Items[ActiveTabIndex]) do
begin
MouseIn := True;
Draw(Canvas);
if Assigned(FOnTabMouseEnter)
then
FOnTabMouseEnter(TspMDITab(ObjectList.Items[ActiveTabIndex]));
end;
OldTabIndex := ActiveTabIndex;
end;
end;
procedure TspSkinMDITabsBar.CalcObjectRects;
var
I, TabW, X: Integer;
begin
if ObjectList.Count = 0 then Exit;
TabW := Width div ObjectList.Count;
if TabW > FDefaultTabWidth
then
TabW := FDefaultTabWidth;
X := 0;
for I := 0 to ObjectList.Count - 1 do
begin
TspMDITab(ObjectList.Items[I]).ObjectRect := Rect(X, 0, X + TabW, Height);
if (I = ObjectList.Count - 1) and (TabW < FDefaultTabWidth) and
(TspMDITab(ObjectList.Items[I]).ObjectRect.Right <> Width)
then
TspMDITab(ObjectList.Items[I]).ObjectRect.Right := Width;
Inc(X, TabW);
end;
end;
procedure TspSkinMDITabsBar.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TspSkinMDITabsBar.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TspSkinMDITabsBar.GetSkinData;
begin
inherited;
//
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinTabControl
then
with TspDataSkinTabControl(FSD.CtrlList.Items[FIndex]) do
begin
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
Self.TabRect := TabRect;
if IsNullRect(ActiveTabRect)
then
Self.ActiveTabRect := TabRect
else
Self.ActiveTabRect := ActiveTabRect;
if IsNullRect(MouseInTabRect)
then
Self.MouseInTabRect := TabRect
else
Self.MouseInTabRect := MouseInTabRect;
//
Self.TabsBGRect := TabsBGRect;
Self.TabLeftOffset := TabLeftOffset;
Self.TabRightOffset := TabRightOffset;
//
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.MouseInFontColor := MouseInFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.UpDown := UpDown;
end;
end;
procedure TspSkinMDITabsBar.ChangeSkinData;
begin
inherited;
if FIndex <> -1
then
Height := RectHeight(TabRect)
else
Height := FDefaultHeight;
end;
procedure TspSkinMDITabsBar.ClearObjects;
var
I: Integer;
begin
if ObjectList.Count > 0
then
for I := 0 to ObjectList.Count - 1 do
TspMDITab(ObjectList.Items[I]).Free;
ObjectList.Clear;
end;
procedure TspSkinMDITabsBar.AddTab(Child: TCustomForm);
begin
ObjectList.Add(TspMDITab.Create(Self, Child));
RePaint;
end;
procedure TspSkinMDITabsBar.DeleteTab(Child: TCustomForm);
var
I: Integer;
begin
for I := 0 to ObjectList.Count - 1 do
if TspMDITab(ObjectList.Items[I]).Child = Child
then
begin
TspMDITab(ObjectList.Items[I]).Free;
ObjectList.Delete(I);
Break;
end;
RePaint;
end;
procedure TspSkinMDITabsBar.CreateControlDefaultImage;
var
I: Integer;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, B.Width, B.Height));
end;
//
if ObjectList.Count > 0
then
begin
CalcObjectRects;
for I := 0 to ObjectList.Count - 1 do
TspMDITab(ObjectList.Items[I]).Draw(B.Canvas);
end;
end;
procedure TspSkinMDITabsBar.CreateControlSkinImage;
var
I: Integer;
rw, rh, w, h, XCnt, YCnt, X, Y, XO, YO: Integer;
begin
w := RectWidth(TabsBGRect);
h := RectHeight(TabsBGRect);
rw := B.Width;
rh := B.Height;
XCnt := rw div w;
YCnt := rh div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > rw then XO := X * w + w - rw else XO := 0;
if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
B.Canvas.CopyRect(Rect(X * w, Y * h, X * w + w - XO, Y * h + h - YO),
Picture.Canvas,
Rect(TabsBGRect.Left, TabsBGRect.Top,
TabsBGRect.Right - XO, TabsBGRect.Bottom - YO));
end;
//
if ObjectList.Count > 0
then
begin
CalcObjectRects;
for I := 0 to ObjectList.Count - 1 do
TspMDITab(ObjectList.Items[I]).Draw(B.Canvas);
end;
end;
end.