Delphi控件源码

开发平台：

Delphi

BusinessSkinForm.pas：源码内容

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 TbsBusinessSkinForm.CheckObjectsHint;
var
i: Integer;
begin
if (not FUseDefaultObjectHint) or (FSD = nil) or (ObjectList.Count = 0) then Exit;
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinAnimateObject
then
with TbsSkinAnimateObject(ObjectList.Items[i]) do
begin
if FSD.ResourceStrData = nil
then
case Command of
cmClose: Hint := BS_CLOSEBUTTON_HINT;
cmMaximize: Hint := BS_MAXBUTTON_HINT;
cmMinimize: Hint := BS_MINBUTTON_HINT;
cmRollUp: Hint := BS_ROLLUPBUTTON_HINT;
cmMinimizeToTray: Hint := BS_TRAYBUTTON_HINT;
cmSysMenu: Hint := BS_MENUBUTTON_HINT;
end
else
case Command of
cmClose: Hint := FSD.ResourceStrData.GetResStr('CLOSEBUTTON_HINT');
cmMaximize: Hint := FSD.ResourceStrData.GetResStr('MAXBUTTON_HINT');
cmMinimize: Hint := FSD.ResourceStrData.GetResStr('MINBUTTON_HINT');
cmRollUp: Hint := FSD.ResourceStrData.GetResStr('ROLLUPBUTTON_HINT');
cmMinimizeToTray: Hint := FSD.ResourceStrData.GetResStr('TRAYBUTTON_HINT');
cmSysMenu: Hint := FSD.ResourceStrData.GetResStr('MENUBUTTON_HINT');
end;
end
else
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinStdButtonObject
then
with TbsSkinStdButtonObject(ObjectList.Items[i]) do
begin
if FSD.ResourceStrData = nil
then
case Command of
cmClose: Hint := BS_CLOSEBUTTON_HINT;
cmMaximize: Hint := BS_MAXBUTTON_HINT;
cmMinimize: Hint := BS_MINBUTTON_HINT;
cmRollUp: Hint := BS_ROLLUPBUTTON_HINT;
cmMinimizeToTray: Hint := BS_TRAYBUTTON_HINT;
cmSysMenu: Hint := BS_MENUBUTTON_HINT;
end
else
case Command of
cmClose: Hint := FSD.ResourceStrData.GetResStr('CLOSEBUTTON_HINT');
cmMaximize: Hint := FSD.ResourceStrData.GetResStr('MAXBUTTON_HINT');
cmMinimize: Hint := FSD.ResourceStrData.GetResStr('MINBUTTON_HINT');
cmRollUp: Hint := FSD.ResourceStrData.GetResStr('ROLLUPBUTTON_HINT');
cmMinimizeToTray: Hint := FSD.ResourceStrData.GetResStr('TRAYBUTTON_HINT');
cmSysMenu: Hint := FSD.ResourceStrData.GetResStr('MENUBUTTON_HINT');
end;
end;
end;
procedure TbsBusinessSkinForm.CheckObjects;
var
i: Integer;
ObjectVisible: Boolean;
begin
if ObjectList.Count > 0 then
if FHideCaptionButtons
then
begin
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinAnimateObject
then
with TbsSkinAnimateObject(ObjectList.Items[i]) do
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinStdButtonObject
then
with TbsSkinStdButtonObject(ObjectList.Items[i]) do
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end;
end
else
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinAnimateObject
then
with TbsSkinAnimateObject(ObjectList.Items[i]) do
begin
if ButtonStyle
then
begin
if (Command = cmDefault)
then
begin
ObjectVisible := False;
if Assigned(FOnActivateCustomObject)
then
FOnActivateCustomObject(IDName, ObjectVisible);
Visible := ObjectVisible;
end
else
if not (biMinimizeToTray in FBorderIcons) and
(Command = cmMinimizeToTray)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
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 TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinStdButtonObject
then
with TbsSkinStdButtonObject(ObjectList.Items[i]) do
begin
if (Command = cmDefault)
then
begin
ObjectVisible := False;
if Assigned(FOnActivateCustomObject)
then
FOnActivateCustomObject(IDName, ObjectVisible);
Visible := ObjectVisible;
end
else
if not (biMinimizeToTray in FBorderIcons) and
(Command = cmMinimizeToTray)
then
begin
Enabled := False;
Visible := not SkinRectInAPicture;
end
else
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;
CheckObjectsHint;
end;
function TbsBusinessSkinForm.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 TbsBusinessSkinForm.GetIndex;
var
i, j: Integer;
begin
j := -1;
for i := 0 to ObjectList.Count - 1 do
begin
if AIDName = TbsActiveSkinObject(ObjectList.Items[i]).IDName
then
begin
j := i;
Break;
end;
end;
Result := j;
end;
procedure TbsBusinessSkinForm.UserObjectDraw;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> -1
then
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsUserObject
then
TbsUserObject(ObjectList.Items[i]).Draw(FForm.Canvas, True);
end;
procedure TbsBusinessSkinForm.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 TbsBusinessSkinForm.InForm;
var
H: HWND;
begin
H := WindowFromPoint(P);
Result := H = FForm.Handle;
end;
function TbsBusinessSkinForm.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 TbsBusinessSkinForm.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:
begin
DoMinimize;
end;
end;
end;
end;
procedure TbsBusinessSkinForm.DoMinimize;
var
P: TPoint;
begin
if (Application.MainForm = FForm)
then
begin
Application.Minimize
end
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 TbsBusinessSkinForm.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 TbsBusinessSkinForm.DoNormalize;
var
OW, OH: Integer;
begin
MaxRollUpState := False;
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
SendMessage(Application.MainForm.Handle, WM_MDICHILDRESTORE, 0, 0);
OldBoundsRect := NullRect;
end;
procedure TbsBusinessSkinForm.LinkMenu;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> - 1 then
if (TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinButtonObject)
then
with TbsSkinButtonObject(ObjectList.Items[i]) do
begin
MenuItem := AMenu.Items;
FPopupUp := APopupUp;
end
else
else
if (TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinAnimateObject)
then
with TbsSkinAnimateObject(ObjectList.Items[i]) do
if ButtonStyle
then
begin
MenuItem := AMenu.Items;
FPopupUp := APopupUp;
end;
end;
procedure TbsBusinessSkinForm.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 TbsBusinessSkinForm.ChangeSkinData;
begin
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
if (FSD = nil) or (FSD.Empty)
then
FSkinSupport := False
else
FSkinSupport := True;
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;
//
if (FClientWidth > 0)
then FForm.ClientWidth := FClientWidth;
if FClientHeight > 0
then FForm.ClientHeight := FClientHeight;
//
end;
procedure TbsBusinessSkinForm.SetMenusSkinData(Value: TbsSkinData);
begin
FMSD := Value;
end;
procedure TbsBusinessSkinForm.SetSkinData(Value: TbsSkinData);
begin
FSD := Value;
// if (FSD <> nil) then
if {not FSD.Empty and} not (csDesigning in ComponentState) then ChangeSkinData;
FSysTrayMenu.SkinData := Value;
end;
procedure TbsBusinessSkinForm.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 TbsBusinessSkinForm.LoadDefObjects;
var
NotNullRect: TRect;
begin
ClearObjects;
NotNullRect := Rect(0, 0, 1, 1);
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, nil));
with TbsSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmClose;
IDName := 'closebutton';
end;
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, nil));
with TbsSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmMaximize;
IDName := 'maxbutton';
end;
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, nil));
with TbsSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmMinimize;
IDName := 'minbutton';
end;
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, nil));
with TbsSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmRollUp;
IDName := 'rollupbutton';
end;
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, nil));
with TbsSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmSysMenu;
IDName := 'sysmenubutton';
end;
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, nil));
with TbsSkinStdButtonObject(ObjectList.Items[ObjectList.Count - 1]) do
begin
SkinRectInAPicture := True;
SkinRect := NotNullRect;
ActiveSkinRect := NotNullRect;
DownRect := NotNullRect;
Command := cmMinimizeToTray;
IDName := 'traybutton';
end;
CheckObjects;
end;
procedure TbsBusinessSkinForm.LoadObjects;
var
i: Integer;
OL: TList;
begin
ClearObjects;
OL := FSD.ObjectList;
for i := 0 to OL.Count - 1 do
begin
if (TbsDataSkinObject(OL.Items[i]) is TbsDataSkinMainMenuItem) or
(TbsDataSkinObject(OL.Items[i]) is TbsDataSkinMenuItem) or
(TbsDataSkinObject(OL.Items[i]) is TbsDataSkinMainMenuBarButton)
then
begin
end
else
if TbsDataSkinObject(OL.Items[i]) is TbsDataSkinStdButton
then
ObjectList.Add(TbsSkinStdButtonObject.Create(Self, TbsDataSkinStdButton(OL.Items[i])))
else
if TbsDataSkinObject(OL.Items[i]) is TbsDataSkinButton
then ObjectList.Add(TbsSkinButtonObject.Create(Self, TbsDataSkinButton(OL.Items[i])))
else
if TbsDataSkinObject(OL.Items[i]) is TbsDataSkinCaption
then ObjectList.Add(TbsSkinCaptionObject.Create(Self, TbsDataSkinCaption(OL.Items[i])))
else
if TbsDataSkinObject(OL.Items[i]) is TbsDataSkinAnimate
then ObjectList.Add(TbsSkinAnimateObject.Create(Self, TbsDataSkinAnimate(OL.Items[i])))
else
if TbsDataSkinObject(OL.Items[i]) is TbsDataUserObject
then ObjectList.Add(TbsUserObject.Create(Self, TbsDataUserObject(OL.Items[i])));
end;
end;
procedure TbsBusinessSkinForm.ClearObjects;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
TbsActiveSkinObject(ObjectList.Items[i]).Free;
ObjectList.Clear;
end;
procedure TbsBusinessSkinForm.TestActive;
var
i: Integer;
B: Boolean;
ObjHint: String;
begin
if (ObjectList.Count = 0) or not GetFormActive then Exit;
OldActiveObject := ActiveObject;
i := -1;
B := False;
repeat
Inc(i);
with TbsActiveSkinObject(ObjectList.Items[i]) do
begin
if 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 TbsActiveSkinObject(ObjectList.Items[OldActiveObject]).Enabled and
TbsActiveSkinObject(ObjectList.Items[OldActiveObject]).Visible
then TbsActiveSkinObject(ObjectList.Items[OldActiveObject]).MouseLeave;
if FShowObjectHint and (FSkinHint <> nil) and
TbsActiveSkinObject(ObjectList.Items[OldActiveObject]).Enabled and
TbsActiveSkinObject(ObjectList.Items[OldActiveObject]).Visible and
(TbsActiveSkinObject(ObjectList.Items[OldActiveObject]).Hint <> '')
then FSkinHint.HideHint;
end;
if ActiveObject <> -1
then
begin
if TbsActiveSkinObject(ObjectList.Items[ActiveObject]).Enabled and
TbsActiveSkinObject(ObjectList.Items[ActiveObject]).Visible
then TbsActiveSkinObject(ObjectList.Items[ActiveObject]).MouseEnter;
// show object hint
if FShowObjectHint and (FSkinHint <> nil) and
TbsActiveSkinObject(ObjectList.Items[ActiveObject]).Enabled and
TbsActiveSkinObject(ObjectList.Items[ActiveObject]).Visible
then
begin
ObjHint := TbsActiveSkinObject(ObjectList.Items[ActiveObject]).Hint;
if ObjHint <> '' then FSkinHint.ActivateHint2(ObjHint);
end;
//
end;
end;
end;
procedure TbsBusinessSkinForm.TestMouse;
var
P: TPoint;
begin
if not GetFormActive then Exit;
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;
procedure TbsBusinessSkinForm.PaintEvent;
begin
if Assigned(FOnPaintEvent) then FOnPaintEvent(IDName, Canvas, ObjectRect);
end;
procedure TbsBusinessSkinForm.MouseUpEvent;
begin
if Assigned(FOnMouseUpEvent)
then FOnMouseUpEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TbsBusinessSkinForm.MouseDownEvent;
begin
if Assigned(FOnMouseDownEvent)
then FOnMouseDownEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TbsBusinessSkinForm.MouseMoveEvent;
begin
if Assigned(FOnMouseMoveEvent)
then FOnMouseMoveEvent(IDName, X, Y, ObjectRect);
end;
procedure TbsBusinessSkinForm.MouseEnterEvent;
begin
if Assigned(FOnMouseEnterEvent) then FOnMouseEnterEvent(IDName);
end;
procedure TbsBusinessSkinForm.MouseLeaveEvent;
begin
if Assigned(FOnMouseLeaveEvent) then FOnMouseLeaveEvent(IDName);
end;
procedure TbsBusinessSkinForm.MouseMove;
begin
if MouseCaptureObject <> -1
then TbsActiveSkinObject(ObjectList.Items[MouseCaptureObject]).MouseMove(X, Y)
else
if ActiveObject <> -1
then TbsActiveSkinObject(ObjectList.Items[ActiveObject]).MouseMove(X, Y);
end;
procedure TbsBusinessSkinForm.MouseDblClick;
begin
if (ActiveObject <> - 1) then
with TbsActiveSkinObject(ObjectList.Items[ActiveObject]) do
begin
DblClick;
end;
end;
procedure TbsBusinessSkinForm.MouseDown;
begin
if (ActiveObject <> - 1) then
with TbsActiveSkinObject(ObjectList.Items[ActiveObject]) do
begin
if not (TbsActiveSkinObject(ObjectList.Items[ActiveObject]) is
TbsSkinCaptionObject)
then SetCapture(FForm.Handle);
MouseCaptureObject := ActiveObject;
MouseDown(X, Y, Button);
end;
end;
procedure TbsBusinessSkinForm.MouseUp;
begin
if (MouseCaptureObject <> -1)
then
begin
if not (TbsActiveSkinObject(ObjectList.Items[MouseCaptureObject]) is
TbsSkinCaptionObject)
then ReleaseCapture;
TbsActiveSkinObject(ObjectList.Items[MouseCaptureObject]).MouseUp(X, Y, Button);
MouseCaptureObject := -1;
end;
end;
function TbsBusinessSkinForm.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 TbsBusinessSkinForm.CalcAllRealObjectRect;
var
i: Integer;
OffsetX, OffsetY, BW, BH: Integer;
Button: TbsActiveSkinObject;
C: TbsSkinCaptionObject;
function GetCaption: TbsSkinCaptionObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinCaptionObject
then
begin
Result := TbsSkinCaptionObject(ObjectList.Items[I]);
Break;
end;
end;
function GetStdButton(C: TbsStdCommand): TbsActiveSkinObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinStdButtonObject
then
begin
with TbsSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TbsActiveSkinObject(ObjectList.Items[I]);
Break;
end;
end
else
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinAnimateObject
then
begin
with TbsSkinAnimateObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TbsActiveSkinObject(ObjectList.Items[I]);
Break;
end;
end;
end;
procedure SetStdButtonRect(B: TbsActiveSkinObject);
begin
if (B <> nil) and (B is TbsSkinStdButtonObject)
then
begin
with TbsSkinStdButtonObject(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 TbsSkinAnimateObject)
then
begin
with TbsSkinAnimateObject(B) do
begin
BW := RectWidth(SkinRect);
BH := RectHeight(SkinRect);
ObjectRect := Rect(OffsetX - BW, OffsetY, OffsetX, OffsetY + BH);
OffsetX := OffsetX - NewButtonsOffset - BW;
end;
end
end;
procedure SetStdButtonRect2(B: TbsActiveSkinObject);
begin
if (B <> nil) and (B is TbsSkinStdButtonObject)
then
begin
with TbsSkinStdButtonObject(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 TbsSkinAnimateObject)
then
begin
with TbsSkinAnimateObject(B) do
begin
BW := RectWidth(SkinRect);
BH := RectHeight(SkinRect);
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + BW, OffsetY + BH);
OffsetX := OffsetX + NewButtonsOffset + BW;
end;
end
end;
procedure SetStdObjectsRect;
var
I: Integer;
begin
Button := GetStdButton(cmClose);
SetStdButtonRect(Button);
Button := GetStdButton(cmMaximize);
SetStdButtonRect(Button);
Button := GetStdButton(cmMinimize);
SetStdButtonRect(Button);
Button := GetStdButton(cmRollUp);
SetStdButtonRect(Button);
Button := GetStdButton(cmMinimizeToTray);
SetStdButtonRect(Button);
// custom buttons
for I := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinStdButtonObject
then
begin
with TbsSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = cmDefault)
then
begin
Button := TbsActiveSkinObject(ObjectList.Items[I]);
SetStdButtonRect(Button);
end;
end
else
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinAnimateObject
then
begin
with TbsSkinAnimateObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = cmDefault)
then
begin
Button := TbsActiveSkinObject(ObjectList.Items[I]);
SetStdButtonRect(Button);
end;
end;
//
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;
var
I: Integer;
begin
Button := GetStdButton(cmClose);
SetStdButtonRect2(Button);
Button := GetStdButton(cmMaximize);
SetStdButtonRect2(Button);
Button := GetStdButton(cmMinimize);
SetStdButtonRect2(Button);
Button := GetStdButton(cmRollUp);
SetStdButtonRect2(Button);
Button := GetStdButton(cmMinimizeToTray);
SetStdButtonRect2(Button);
// custom buttons
for I := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinStdButtonObject
then
begin
with TbsSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = cmDefault)
then
begin
Button := TbsActiveSkinObject(ObjectList.Items[I]);
SetStdButtonRect2(Button);
end;
end
else
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinAnimateObject
then
begin
with TbsSkinAnimateObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = cmDefault)
then
begin
Button := TbsActiveSkinObject(ObjectList.Items[I]);
SetStdButtonRect2(Button);
end;
end;
//
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 TbsActiveSkinObject(ObjectList.Items[i]) do
if not SkinRectInAPicture
then
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 TbsBusinessSkinForm.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 TbsBusinessSkinForm.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 TbsBusinessSkinForm.PaintBG(DC: HDC);
var
C: TCanvas;
X, Y, XCnt, YCnt, w, h, rw, rh: Integer;
R: TRect;
BGImage: TBitMap;
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;
BGImage.Width := RectWidth(FSD.ClRect);
BGImage.Height := RectHeight(FSD.ClRect);
BGImage.Canvas.CopyRect(Rect(0, 0, BGImage.Width, BGImage.Height),
FSD.FPicture.Canvas, Rect(FSD.ClRect.Left, FSD.ClRect.Top,
FSD.ClRect.Right, FSD.ClRect.Bottom));
if (FForm.ClientWidth > 0) and (FForm.ClientHeight > 0)
then
begin
w := RectWidth(FSD.ClRect);
h := RectHeight(FSD.ClRect);
rw := FForm.ClientWidth;
rh := FForm.ClientHeight;
XCnt := rw div w;
YCnt := rh div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
C.Draw(X * w, Y * h, BGImage);
end;
BGImage.Free;
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
C.Free;
end;
function TbsBusinessSkinForm.GetDefCaptionRect: TRect;
begin
CalcDefRects;
Result := NewDefCaptionRect;
end;
function TbsBusinessSkinForm.NewDefNCHitTest;
const
Offset = 2;
var
CR: TRect;
begin
if (FWindowState = wsMaximized) or FRollUpState or not IsSizeAble 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 TbsBusinessSkinForm.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 TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinCaptionObject
then
with TbsSkinCaptionObject(ObjectList.Items[i]) do
if 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 IsSizeAble
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 TbsBusinessSkinForm.FindHotKeyItem;
begin
if FMainMenuBar <> nil
then
Result := FMainMenuBar.FindHotKeyItem(CharCode)
else
Result := False;
end;
function TbsBusinessSkinForm.CanNextMainMenuItem;
var
PW: TbsSkinPopupWindow;
begin
if SkinMenu.FPopupList.Count = 0
then
Result := True
else
with SkinMenu do
begin
PW := TbsSkinPopupWindow(FPopupList.Items[FPopupList.Count - 1]);
if PW.ActiveItem <> -1
then
begin
if TbsSkinMenuItem(PW.ItemList[PW.ActiveItem]).MenuItem.Count = 0
then
Result := True
else
Result := False;
end
else
Result := True
end;
end;
function TbsBusinessSkinForm.CanPriorMainMenuItem;
begin
if SkinMenu.FPopupList.Count < 2 then Result := True else Result := False;
end;
function TbsBusinessSkinForm.CheckReturnKey;
begin
if FMainMenuBar <> nil
then
Result := FMainMenuBar.CheckReturnKey
else
Result := False;
end;
procedure TbsBusinessSkinForm.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;
FOld := False;
R := Rect(0, 0, FForm.ClientWidth, FForm.ClientHeight);
if not FLogoBitMap.Empty
then
ReDrawWindow(FForm.ClientHandle, @R, 0, RDW_ERASE or RDW_INVALIDATE);
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 TbsBusinessSkinForm.FormKeyDown(Message: TMessage);
var
BSF: TbsBusinessSkinForm;
begin
if (FForm.FormStyle = fsMDIChild)
then
begin
BSF := GetBusinessSkinFormComponent(Application.MainForm);
if BSF <> nil
then
begin
if BSF.InMenu or BSF.InMainMenu or BSF.SkinMenu.Visible
then
begin
BSF.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;
end
else
if (TWMKeyDown(Message).CharCode = VK_RIGHT) and InMainMenu and
CanNextMainMenuItem
then
begin
if FMainMenuBar <> nil
then FMainMenuBar.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
TbsSkinPopupWindow(FPopupList.Items[FPopupList.Count - 1]).PopupKeyDown(CharCode);
end;
end
else
with TWMKeyDown(Message), SkinMenu do
begin
if Visible and (FPopupList.Count > 0)
then
TbsSkinPopupWindow(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 TbsBusinessSkinForm.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 TbsBusinessSkinForm.CheckMenuVisible;
var
BS: TbsBusinessSkinForm;
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
BS := GetMDIChildBusinessSkinFormComponent2;
if BS <> nil then BS.CheckMenuVisible(Msg);
end;
end;
end;
procedure TbsBusinessSkinForm.NewWndProc(var Message: TMessage);
const
WM_SYNCPAINT = $0088;
WS_EX_LAYERED = $80000;
var
MM: PMINMAXINFO;
Old: boolean;
P: TPoint;
L, T, I, J: Integer;
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
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;
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) 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 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:
begin
P.X := Short(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;
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_CHANGERESSTRDATA:
begin
CheckObjectsHint;
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:
begin
UpDateActiveObjects;
MouseTimer.Enabled := False;
ActiveObject := -1;
MouseCaptureObject := -1;
FSizeMove := True;
FFullDrag := GetFullDragg;
end;
WM_EXITSIZEMOVE:
begin
MouseTimer.Enabled := False;
ActiveObject := -1;
OldActiveObject := -1;
MouseCaptureObject := -1;
// FSizeMove := False;
if (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 (FSD <> nil) and
(FForm.Width >= GetMinWidth) and
(FForm.Height >= GetMinHeight)
then
CreateNewForm(True);
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
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0)
else
begin
if (FSD <> nil) and
(FFormWidth >= GetMinWidth) and
(FFormHeight >= GetMinHeight)
then
CreateNewForm(True);
end;
if FAlphaBlend and (FAlphaBlendValue <> 255) and CheckW2KWXP
then
begin
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
FForm.RePaint;
end;
if not FLogoBitMap.Empty and (FForm.FormStyle <> fsMDIForm)
then
FForm.RePaint;
end
else
if 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
OldWindowProc(Message);
SendMessage(FForm.Handle, WM_NCPaint, 0, 0);
if (FForm.FormStyle = fsMDIChild) and (WindowState = wsMaximized)
then FormChangeActive(False)
else
begin
UpDateActiveObjects;
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 not ((FForm.FormStyle = fsMDIChild) and
(WindowState = wsMaximized)) and (FForm.BorderStyle <> bsNone)
then
if (FSD <> nil) and not FSD.Empty
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
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 FSkinSupport
then
PaintNCSkin
else
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
then UpDateChildActiveInMenu;
//
Old := False;
if (FForm.FormStyle = fsMDIChild) and (WindowState = wsMaximized)
then
begin
Application.MainForm.Perform(WM_NCPAINT, 0, 0);
end;
if (FForm.FormStyle = fsMDIChild)
then
begin
CheckMDIMainMenu;
CheckMDIBar;
end;
end;
WM_ERASEBKGND:
if (FForm.FormStyle <> fsMDIForm)
then
begin
if FSkinSupport
then
begin
if FSD.BGPictureIndex = -1
then
PaintBG(wParam)
else
PaintBG2(wParam);
end
else
PaintBGDefault(wParam);
Old := False;
end;
end;
if Old then OldWindowProc(Message);
case Msg of
WM_LBUTTONUP:
begin
MouseUp(mbLeft, -1, -1);
end;
WM_RBUTTONUP:
begin
MouseUp(mbRight, -1, -1);
end;
WM_NCMOUSEMOVE:
begin
P.X := Short(LoWord(lParam));
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseMove(P.X, P.Y);
end;
WM_NCLBUTTONDBLCLK:
begin
P.X := Short(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 IsSizeAble and (WindowState = wsMinimized)
then
begin
WindowState := wsNormal;
MouseCaptureObject := -1;
end
else
if IsSizeAble and (WindowState <> wsMaximized) and not FRollUpState and
(biMaximize in BorderIcons)
then
begin
WindowState := wsMaximized;
MouseCaptureObject := -1;
end
else
if IsSizeAble 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:
begin
P.X := Short(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 not FSizeMove then
begin
P.X := Short(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;
WM_NCLBUTTONUP:
begin
P.X := Short(LoWord(lParam));
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseUp(mbLeft, LoWord(LParam), HiWord(LParam));
end;
WM_NCRBUTTONDOWN:
begin
P.X := Short(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:
begin
P.X := Short(LoWord(lParam));
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseUp(mbRight, P.X, P.Y);
end;
end;
end;
end;
procedure TbsBusinessSkinForm.CheckMDIMainMenu;
var
BS: TbsBusinessSkinForm;
begin
BS := GetBusinessSkinFormComponent(Application.MainForm);
if (BS <> nil) and (BS.MainMenuBar <> nil) and
((BS.MainMenuBar.GetChildMainMenu <> nil) or BS.MainMenuBar.ChildMenuIn)
then
BS.MainMenuBar.UpDateItems;
end;
procedure TbsBusinessSkinForm.CheckMDIBar;
var
BS: TbsBusinessSkinForm;
begin
BS := GetBusinessSkinFormComponent(Application.MainForm);
if (BS <> nil) and (BS.MDITabsBar <> nil)
then
BS.MDITabsBar.CheckActive;
end;
procedure TbsBusinessSkinForm.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);
end;
end;
procedure TbsBusinessSkinForm.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 FRgn = 0
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsBusinessSkinForm.CreateNewRegion;
var
Size: Integer;
RgnData: PRgnData;
R1, R2, R3, R4, TempRgn: HRGN;
begin
if (FForm.BorderStyle = bsNone)
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 TbsBusinessSkinForm.GetFormActive;
begin
if PreviewMode
then
Result := True
else
if (FForm.FormStyle = fsMDIChild) or (FForm.FormStyle = fsMDIForm)
then
Result := FFormActive
else
Result := FForm.Active;
end;
procedure TbsBusinessSkinForm.FormChangeActive;
var
i: Integer;
FA: Boolean;
begin
FA := GetFormActive;
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinCaptionObject
then
with TbsSkinCaptionObject(ObjectList.Items[i]) do
if (Active <> FA)
then
begin
Active := FA;
if AUpDate
then
begin
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
if Morphing
then MorphTimer.Enabled := True;
end
else
if Morphing
then
if Active
then
FMorphKf := 1
else
FMorphKf := 0;
Break;
end;
if FA
then
begin
if Assigned(FOnActivate) then FOnActivate(Self);
end
else
begin
if Assigned(FOnDeActivate) then FOnDeActivate(Self);
end;
end;
procedure TbsBusinessSkinForm.SetEnabled;
var
i: Integer;
begin
i := GetIndex(AIDName);
if i <> -1
then
TbsActiveSkinObject(ObjectList.Items[i]).Enabled := Value;
end;
constructor TbsMDITab.Create;
begin
TabsBar := AParentBar;
Child := AChild;
ObjectRect := NullRect;
Active := False;
MouseIn := False;
end;
procedure TbsMDITab.Draw(Cnvs: TCanvas);
procedure DrawFlipVert(B: TBitMap);
var
B1, B2: TbsEffectBmp;
begin
B1 := TbsEffectBmp.CreateFromhWnd(B.Handle);
B2 := TbsEffectBmp.Create(B1.Width, B1.Height);
B1.FlipVert(B2);
B2.Draw(B.Canvas.Handle, 0, 0);
B1.Free;
B2.Free;
end;
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;
if TabsBar.Align = alBottom then DrawFlipVert(TB);
with TB.Canvas.Font do
begin
Name := TabsBar.FontName;
Style := TabsBar.FontStyle;
Height := TabsBar.FontHeight;
if (TabsBar.SkinData <> nil) and (TabsBar.SkinData.ResourceStrData <> nil)
then
CharSet := TabsBar.SkinData.ResourceStrData.Charset
else
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 := BS_XP_BTNACTIVECOLOR
else
if Active
then
Brush.Color := BS_XP_BTNDOWNCOLOR
else
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, TB.Width, TB.Height));
Brush.Style := bsClear;
Font.Assign(TabsBar.DefaultFont);
if (TabsBar.SkinData <> nil) and (TabsBar.SkinData.ResourceStrData <> nil)
then
Font.CharSet := TabsBar.SkinData.ResourceStrData.Charset;
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 TbsSkinMDITabsBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMoveTabs := True;
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;
DragIndex := -1;
IsDrag := False;
FDown := False;
end;
destructor TbsSkinMDITabsBar.Destroy;
begin
ClearObjects;
ObjectList.Free;
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinMDITabsBar.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 TbsMDITab(ObjectList.Items[I]) do
begin
Active := (Child = F);
end;
RePaint;
end;
procedure TbsSkinMDITabsBar.MouseUp;
var
I: Integer;
Tab: TbsMDITab;
begin
inherited;
FDown := False;
if IsDrag
then
begin
IsDrag := False;
FDown := False;
//
I := GetMoveIndex;
If (I <> -1) and (I <> DragIndex)
then
ObjectList.Move(DragIndex, I);
//
DragIndex := -1;
DX := 0;
TabDX := 0;
RePaint;
end
else
if Assigned(FOnTabMouseUp)
then
begin
Tab := GetTab(X, Y);
if Tab <> nil then FOnTabMouseUp(Button, Shift, Tab);
end;
end;
function TbsSkinMDITabsBar.GetMoveIndex;
var
I: Integer;
R: TRect;
X: Integer;
begin
Result := -1;
if ObjectList.Count = 0 then Exit;
if TabDX > 0
then
begin
X := TbsMDITab(ObjectList.Items[DragIndex]).ObjectRect.Right;
if DragIndex + 1 <= ObjectList.Count - 1 then
for I := DragIndex + 1 to ObjectList.Count - 1 do
begin
R := TbsMDITab(ObjectList.Items[I]).ObjectRect;
if X > R.Left + RectWidth(R) div 2
then Result := I;
end;
end
else
if TabDX < 0
then
begin
X := TbsMDITab(ObjectList.Items[DragIndex]).ObjectRect.Left;
if DragIndex - 1 >= 0 then
begin
for i := DragIndex - 1 downto 0 do
begin
R := TbsMDITab(ObjectList.Items[I]).ObjectRect;
if X < R.Left + RectWidth(R) div 2
then Result := I;
end;
end;
end;
end;
procedure TbsSkinMDITabsBar.MouseMove;
begin
inherited;
if FDown and (DragIndex <> -1) and not IsDrag and (X - DX <> 0)
then
IsDrag := True;
if IsDrag
then
begin
TabDX := X - DX;
RePaint;
end
else
TestActive(X, Y);
end;
procedure TbsSkinMDITabsBar.MouseDown;
var
Tab: TbsMDITab;
ChildBSF: TbsBusinessSkinForm;
begin
inherited;
if Button = mbLeft
then
begin
Tab := GetTab(X, Y);
if Tab <> nil
then
begin
Tab.Child.Show;
ChildBSF := GetBusinessSkinFormComponent(Tab.Child);
if (ChildBSF <> nil) and (ChildBSF.WindowState = wsMinimized)
then
ChildBSF.WindowState := wsNormal;
FDown := True;
if FMoveTabs then DragIndex := GetTabIndex(X, Y);
DX := X;
TabDX := 0;
if Assigned(FOnTabMouseDown) then FOnTabMouseDown(Button, Shift, Tab);
end;
end;
end;
procedure TbsSkinMDITabsBar.CMMouseLeave;
begin
inherited;
TestActive(-1, -1);
end;
function TbsSkinMDITabsBar.GetTabIndex;
var
I: Integer;
R: TRect;
begin
Result := -1;
if ObjectList.Count > 0
then
for I := 0 to ObjectList.Count - 1 do
begin
R := TbsMDITab(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 TbsSkinMDITabsBar.GetTab;
var
I: Integer;
begin
I := GetTabIndex(X, Y);
if I <> -1
then
Result := TbsMDITab(ObjectList.Items[I])
else
Result := nil;
end;
procedure TbsSkinMDITabsBar.TestActive;
var
Tab: TbsMDITab;
begin
ActiveTabIndex := GetTabIndex(X, Y);
if (ActiveTabIndex <> OldTabIndex)
then
begin
if OldTabIndex <> -1
then
with TbsMDITab(ObjectList.Items[OldTabIndex]) do
begin
MouseIn := False;
Draw(Canvas);
if Assigned(FOnTabMouseLeave)
then
FOnTabMouseLeave(TbsMDITab(ObjectList.Items[OldTabIndex]));
end;
if ActiveTabIndex <> -1
then
with TbsMDITab(ObjectList.Items[ActiveTabIndex]) do
begin
MouseIn := True;
Draw(Canvas);
if Assigned(FOnTabMouseEnter)
then
FOnTabMouseEnter(TbsMDITab(ObjectList.Items[ActiveTabIndex]));
end;
OldTabIndex := ActiveTabIndex;
end;
end;
procedure TbsSkinMDITabsBar.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
TbsMDITab(ObjectList.Items[I]).ObjectRect := Rect(X, 0, X + TabW, Height);
if (I = ObjectList.Count - 1) and (TabW < FDefaultTabWidth) and
(TbsMDITab(ObjectList.Items[I]).ObjectRect.Right <> Width)
then
TbsMDITab(ObjectList.Items[I]).ObjectRect.Right := Width;
Inc(X, TabW);
end;
if (DragIndex <> -1) and IsDrag
then
with TbsMDITab(ObjectList.Items[DragIndex]) do
begin
OffsetRect(ObjectRect, TabDX, 0);
if ObjectRect.Right > Width
then
OffsetRect(ObjectRect, Width - ObjectRect.Right, 0);
if ObjectRect.Left < 0
then
begin
OffsetRect(ObjectRect, -ObjectRect.Left, 0);
end;
end;
end;
procedure TbsSkinMDITabsBar.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TbsSkinMDITabsBar.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TbsSkinMDITabsBar.GetSkinData;
begin
inherited;
//
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinTabControl
then
with TbsDataSkinTabControl(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 := FocusFontColor;
Self.MouseInFontColor := MouseInFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.UpDown := UpDown;
end;
end;
procedure TbsSkinMDITabsBar.ChangeSkinData;
begin
inherited;
if FIndex <> -1
then
Height := RectHeight(TabRect)
else
Height := FDefaultHeight;
end;
procedure TbsSkinMDITabsBar.ClearObjects;
var
I: Integer;
begin
if ObjectList.Count > 0
then
for I := 0 to ObjectList.Count - 1 do
TbsMDITab(ObjectList.Items[I]).Free;
ObjectList.Clear;
end;
procedure TbsSkinMDITabsBar.AddTab(Child: TCustomForm);
begin
ObjectList.Add(TbsMDITab.Create(Self, Child));
RePaint;
end;
procedure TbsSkinMDITabsBar.DeleteTab(Child: TCustomForm);
var
I: Integer;
begin
for I := 0 to ObjectList.Count - 1 do
if TbsMDITab(ObjectList.Items[I]).Child = Child
then
begin
TbsMDITab(ObjectList.Items[I]).Free;
ObjectList.Delete(I);
Break;
end;
RePaint;
end;
procedure TbsSkinMDITabsBar.CreateControlDefaultImage;
var
I, X: Integer;
R: TRect;
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
if (I <> DragIndex) or not FDown
then
TbsMDITab(ObjectList.Items[I]).Draw(B.Canvas);
if (DragIndex <> -1) and IsDrag
then
begin
TbsMDITab(ObjectList.Items[DragIndex]).Draw(B.Canvas);
I := Self.GetMoveIndex;
if I <> -1
then
begin
R := TbsMDITab(ObjectList.Items[I]).ObjectRect;
with B.Canvas do
begin
Pen.Mode := pmNot;
Brush.Style := bsClear;
if TabDX > 0
then
X := R.Right
else
X := R.Left;
MoveTo(X, 0); LineTo(X, Height);
MoveTo(X + 1, 0); LineTo(X + 1, Height);
MoveTo(X - 1, 0); LineTo(X - 1, Height);
MoveTo(X + 2, Height div 2);
LineTo(X + 5, Height div 2 - 3);
LineTo(X + 5, Height div 2 + 3);
LineTo(X + 2, Height div 2);
MoveTo(X - 2, Height div 2);
LineTo(X - 5, Height div 2 - 3);
LineTo(X - 5, Height div 2 + 3);
LineTo(X - 2, Height div 2);
end;
end;
end;
end;
end;
procedure TbsSkinMDITabsBar.CreateControlSkinImage;
var
I: Integer;
rw, rh, w, h, XCnt, YCnt, X, Y, XO, YO: Integer;
R: TRect;
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
if (I <> DragIndex) or not FDown
then
TbsMDITab(ObjectList.Items[I]).Draw(B.Canvas);
if (DragIndex <> -1) and IsDrag
then
begin
TbsMDITab(ObjectList.Items[DragIndex]).Draw(B.Canvas);
I := Self.GetMoveIndex;
if I <> -1
then
begin
R := TbsMDITab(ObjectList.Items[I]).ObjectRect;
with B.Canvas do
begin
Pen.Mode := pmNot;
Brush.Style := bsClear;
if TabDX > 0
then
X := R.Right
else
X := R.Left;
MoveTo(X, 0); LineTo(X, Height);
MoveTo(X + 1, 0); LineTo(X + 1, Height);
MoveTo(X - 1, 0); LineTo(X - 1, Height);
MoveTo(X + 2, Height div 2);
LineTo(X + 5, Height div 2 - 3);
LineTo(X + 5, Height div 2 + 3);
LineTo(X + 2, Height div 2);
MoveTo(X - 2, Height div 2);
LineTo(X - 5, Height div 2 - 3);
LineTo(X - 5, Height div 2 + 3);
LineTo(X - 2, Height div 2);
end;
end;
end;
end;
end;
end.