Delphi控件源码

开发平台：

Delphi

BusinessSkinForm.pas：源码内容

begin
if (FForm.BorderStyle = bsToolWindow) or
(FForm.BorderStyle = bsSizeToolWin)
then
Result := DEFTOOLCAPTIONHEIGHT
else
Result := DEFCAPTIONHEIGHT;
end;
function TbsBusinessSkinForm.GetDefButtonSize: Integer;
begin
if (FForm.BorderStyle = bsToolWindow) or
(FForm.BorderStyle = bsSizeToolWin)
then
Result := DEFTOOLBUTTONSIZE
else
Result := DEFBUTTONSIZE;
end;
procedure TbsBusinessSkinForm.ArangeMinimizedChilds;
var
I: Integer;
BS: TbsBusinessSkinForm;
P: TPoint;
begin
for i := 0 to FForm.MDIChildCount - 1 do
begin
BS := GetBusinessSkinFormComponent(FForm.MDIChildren[i]);
if BS <> nil
then
begin
if BS.WindowState = wsMinimized
then
begin
P := BS.GetMinimizeCoord;
FForm.MDIChildren[i].Left := P.X;
FForm.MDIChildren[i].Top := P.Y;
end;
end;
end;
end;
procedure TbsBusinessSkinForm.SetDefaultMenuItemHeight(Value: Integer);
begin
if Value > 0 then
SkinMenu.DefaultMenuItemHeight := Value;
end;
function TbsBusinessSkinForm.GetDefaultMenuItemHeight: Integer;
begin
Result := SkinMenu.DefaultMenuItemHeight;
end;
procedure TbsBusinessSkinForm.SetDefaultMenuItemFont(Value: TFont);
begin
SkinMenu.DefaultMenuItemFont.Assign(Value);
end;
function TbsBusinessSkinForm.GetDefaultMenuItemFont: TFont;
begin
Result := SkinMenu.DefaultMenuItemFont;
end;
procedure TbsBusinessSkinForm.SetBorderIcons;
begin
FBorderIcons := Value;
LoadDefObjects;
CheckObjects;
end;
procedure TbsBusinessSkinForm.SetDefCaptionFont;
begin
FDefCaptionFont.Assign(Value);
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState) and not FSkinSupport
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsBusinessSkinForm.SetDefInActiveCaptionFont;
begin
FDefInActiveCaptionFont.Assign(Value);
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState) and not FSkinSupport
then SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsBusinessSkinForm.CorrectCaptionText;
var
j: Integer;
begin
j := Length(S);
with C do
begin
if TextWidth(S) > w
then
begin
repeat
Delete(S, j, 1);
Dec(j);
until (TextWidth(S + '...') <= w) or (S = '');
S := S + '...';
end;
end;
end;
procedure TbsBusinessSkinForm.CalcDefRects;
var
i: Integer;
BSize: Integer;
OffsetX, OffsetY: Integer;
Button: TbsSkinStdButtonObject;
procedure SetStdButtonRect(B: TbsSkinStdButtonObject);
begin
if B <> nil
then
with B do
begin
ObjectRect := Rect(OffsetX - BSize, OffsetY, OffsetX, OffsetY + BSize);
OffsetX := OffsetX - BSize;
end;
end;
procedure SetStdButtonRect2(B: TbsSkinStdButtonObject);
var
IX, IY: Integer;
begin
if B <> nil
then
with B do
begin
if (Command = cmSysMenu) and Parent.ShowIcon
then
begin
GetIconSize(IX, IY);
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + IX, OffsetY + IY);
OffsetX := OffsetX + IX;
end
else
begin
ObjectRect := Rect(OffsetX, OffsetY, OffsetX + BSize, OffsetY + BSize);
OffsetX := OffsetX + BSize;
end;
end;
end;
function GetStdButton(C: TbsStdCommand): TbsSkinStdButtonObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinStdButtonObject
then
with TbsSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TbsSkinStdButtonObject(ObjectList.Items[I]);
Break;
end;
end;
begin
if (ObjectList = nil) or (ObjectList.Count = 0) then Exit;
i := 0;
OffsetX := FFormWidth - 3;
OffsetY := 4;
NewDefCaptionRect := Rect(3, 3, OffsetX, GetDefCaptionHeight);
BSize := GetDefButtonSize;
Button := GetStdButton(cmClose);
SetStdButtonRect(Button);
Button := GetStdButton(cmMaximize);
SetStdButtonRect(Button);
Button := GetStdButton(cmMinimize);
SetStdButtonRect(Button);
Button := GetStdButton(cmRollUp);
SetStdButtonRect(Button);
NewDefCaptionRect.Right := OffsetX;
OffsetX := NewDefCaptionRect.Left;
Button := GetStdButton(cmSysMenu);
if Button <> nil
then
begin
SetStdButtonRect2(Button);
NewDefCaptionRect.Left := OffsetX;
end;
end;
procedure TbsBusinessSkinForm.PaintNCDefault;
var
PaintRect, R: TRect;
CB: TBitMap;
i: Integer;
TX, TY: Integer;
C: TColor;
LeftOffset, RightOffset: Integer;
S: String;
DC: HDC;
Cnvs: TControlCanvas;
F: TForm;
FA: Boolean;
begin
if FFormWidth = 0 then FFormWidth := FForm.Width;
if FFormHeight = 0 then FFormHeight := FForm.Height;
CalcDefRects;
DC := GetWindowDC(FForm.Handle);
Cnvs := TControlCanvas.Create;
Cnvs.Handle := DC;
CB := TBitMap.Create;
CB.Width := FFormWidth - 6;
CB.Height := GetDefCaptionHeight;
LeftOffset := NewDefCaptionRect.Left - 3;
RightOffset := CB.Width - NewDefCaptionRect.Right;
// create caption
with CB.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, CB.Width, CB.Height));
C := clBtnShadow;
for i := 2 to GetDefCaptionHeight - 4 do
begin
if C = clBtnShadow then C := clBtnHighLight else C := clBtnShadow;
Pen.Color := C;
MoveTo(LeftOffset + 2, i); LineTo(CB.Width - RightOffset - 6, i);
end;
FA := GetFormActive;
if FA
then
begin
CB.Canvas.Font.Assign(FDefCaptionFont);
Font := DefCaptionFont;
end
else
begin
CB.Canvas.Font.Assign(FDefInActiveCaptionFont);
Font := DefInActiveCaptionFont;
end;
// paint caption text
S := FForm.Caption;
if (FForm.FormStyle = fsMDIForm) and FMDIChildMaximized
then
begin
F := GetMaximizeMDIChild;
if F <> nil
then
S := S + ' - [' + F.Caption + ']';
end;
if S <> ''
then
begin
CorrectCaptionText(CB.Canvas, S, CB.Width - LeftOffset - RightOffset);
TX := LeftOffset + (CB.Width - LeftOffset - RightOffset) div 2 -
(TextWidth(S) + 5) div 2;
TY := GetDefCaptionHeight div 2 - TextHeight(S) div 2;
R := Rect(TX, 0, TX + TextWidth(S) + 5, CB.Height);
TextRect(R, TX + 3, TY, S);
end;
end;
if (ObjectList.Count = 0) and not FSkinSupport then LoadDefObjects;
if (ObjectList <> nil) and (ObjectList.Count > 0)
then
begin
CalcDefRects;
for i := 0 to ObjectList.Count - 1 do
with TbsActiveSkinObject(ObjectList.Items[i]) do
if Visible then
begin
OffsetRect(ObjectRect, -3, -3);
Draw(CB.Canvas, True);
OffsetRect(ObjectRect, 3, 3);
end;
end;
//paint border + caption
with Cnvs do
begin
ExcludeClipRect(Cnvs.Handle, 3, GetDefCaptionHeight + 3, FFormWidth - 3, FFormHeight - 3);
PaintRect := Rect(0, 0, FFormWidth, FFormHeight);
Draw(3, 3, CB);
Frame3D(Cnvs, PaintRect, cl3DLight, cl3DDKShadow, 1);
Frame3D(Cnvs, PaintRect, clBtnHighLight, clBtnShadow, 1);
Frame3D(Cnvs, PaintRect, clBtnFace, clBtnFace, 1);
CB.Free;
end;
Cnvs.Free;
ReleaseDC(FForm.Handle, DC);
end;
procedure TbsBusinessSkinForm.PaintBGDefault;
var
C: TCanvas;
begin
C := TCanvas.Create;
C.Handle := DC;
with C do
begin
Brush.Color := clBtnFace;
FillRect(FForm.ClientRect);
end;
C.Free;
end;
procedure TbsBusinessSkinForm.PaintMDIBGDefault(DC: HDC);
var
C: TCanvas;
begin
C := TCanvas.Create;
C.Handle := DC;
with C do
begin
Brush.Color := clAppWorkSpace;
FillRect(FForm.ClientRect);
end;
C.Free;
end;
procedure TbsBusinessSkinForm.HookApp;
begin
OldAppMessage := Application.OnMessage;
Application.OnMessage := NewAppMessage;
end;
procedure TbsBusinessSkinForm.UnHookApp;
begin
Application.OnMessage := OldAppMessage;
end;
function TbsBusinessSkinForm.GetMaximizeMDIChild: TForm;
var
i: Integer;
BS: TbsBusinessSkinForm;
begin
Result := nil;
BS := nil;
if Application.MainForm.ActiveMDIChild <> nil
then
BS := GetBusinessSkinFormComponent(Application.MainForm.ActiveMDIChild);
if (BS <> nil) and (BS.WindowState = wsMaximized)
then
Result := Application.MainForm.ActiveMDIChild
else
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
BS := GetBusinessSkinFormComponent(Application.MainForm.MDIChildren[i]);
if (BS <> nil) and (BS.WindowState = wsMaximized)
then
begin
Result := Application.MainForm.MDIChildren[i];
Break;
end;
end;
end;
function TbsBusinessSkinForm.IsMDIChildMaximized;
begin
Result := FMDIChildMaximized;
end;
procedure TbsBusinessSkinForm.Tile;
var
ColumnCount: Integer;
FInColumnCount: Integer;
R: TRect;
W, H: Integer;
i, j, X, Y, FW, FH, L, T: Integer;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
RestoreAll;
ColumnCount := Trunc(Sqrt(FForm.MDIChildCount));
if ColumnCount <= 0 then Exit;
FInColumnCount := FForm.MDIChildCount div ColumnCount;
if FInColumnCount * ColumnCount < FForm.MDIChildCount
then Inc(FInColumnCount, 1);
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
FW := W div ColumnCount;
FH := H div FInColumnCount;
X := W;
Y := H;
j := ColumnCount;
for i := FForm.MDIChildCount downto 1 do
begin
L := X - FW;
T := Y - FH;
if L < 0 then L := 0;
if T < 0 then T := 0;
FForm.MDIChildren[i - 1].SetBounds(L, T, FW, FH);
Y := Y - FH;
if (Y - FH < 0) and (i <> 0)
then
begin
Y := H;
X := X - FW;
Dec(j);
if j = 0 then j := 1;
FInColumnCount := (i - 1) div j;
if FInColumnCount * j < (i - 1)
then Inc(FInColumnCount, 1);
if FInColumnCount = 0
then FInColumnCount := 1;
FH := H div FInColumnCount;
end;
end;
end;
procedure TbsBusinessSkinForm.Cascade;
var
i, j, k, FW, FH, W, H, Offset1, Offset2: Integer;
R: TRect;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
RestoreAll;
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
if FSkinSupport
then
Offset1 := NewClRect.Top
else
Offset1 := GetDefCaptionHeight + 3;
Offset2 := W - Round(W * 0.8);
j := Offset2 div Offset1;
if FForm.MDIChildCount < j
then
begin
FW := W - (FForm.MDIChildCount - 1) * Offset1;
FH := H - (FForm.MDIChildCount - 1) * Offset1;
end
else
begin
FW := W - j * Offset1;
FH := H - j * Offset1;
end;
if FW < GetMinWidth then FW := GetMinWidth;
if FH < GetMinHeight then FH := GetMinHeight;
k := 0;
for i := FForm.MDIChildCount - 1 downto 0 do
begin
FForm.MDIChildren[i].SetBounds(k, k, FW, FH);
k := k + Offset1;
if (k + FW > W) or (K + FH > H)
then k := 0;
end;
end;
procedure TbsBusinessSkinForm.MinimizeAll;
var
i: Integer;
BS: TbsBusinessSkinForm;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
for i := 0 to FForm.MDIChildCount - 1 do
begin
BS := GetBusinessSkinFormComponent(FForm.MDIChildren[i]);
if BS <> nil then BS.WindowState := wsMinimized;
end;
end;
procedure TbsBusinessSkinForm.MaximizeAll;
var
i: Integer;
BS: TbsBusinessSkinForm;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
for i := 0 to FForm.MDIChildCount - 1 do
begin
BS := GetBusinessSkinFormComponent(FForm.MDIChildren[i]);
if BS <> nil then BS.WindowState := wsMaximized;
end;
end;
procedure TbsBusinessSkinForm.CloseAll;
var
i: Integer;
begin
if FForm.FormStyle = fsMDIForm
then
for i := FForm.MDIChildCount - 1 downto 0 do
FForm.MDIChildren[i].Close;
end;
procedure TbsBusinessSkinForm.RestoreAll;
var
i: Integer;
BS: TbsBusinessSkinForm;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
for i := 0 to FForm.MDIChildCount - 1 do
begin
BS := GetBusinessSkinFormComponent(FForm.MDIChildren[i]);
if (BS <> nil) and (BS.WindowState <> wsNormal) then BS.WindowState := wsNormal;
if BS.RollUpState and (BS.WindowState = wsNormal) then BS.RollUpState := False;
end;
end;
procedure TbsBusinessSkinForm.ResizeMDIChilds;
var
i: Integer;
begin
for i := 0 to FForm.MDIChildCount - 1 do
SendMessage(FForm.MDIChildren[i].Handle, WM_MDICHANGESIZE, 0, 0);
ArangeMinimizedChilds;
end;
function TbsBusinessSkinForm.GetMDIWorkArea;
function GetTop: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := 0;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alTop) and
(Controls[i].Top + Controls[i].Height > j)
then
j := Controls[i].Top + Controls[i].Height;
end;
Result := j;
end;
function GetBottom: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := ClientHeight;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alBottom) and
(Controls[i].Top < j)
then
j := Controls[i].Top;
end;
Result := j;
end;
function GetLeft: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := 0;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alLeft) and
(Controls[i].Left + Controls[i].Width > j)
then
j := Controls[i].Left + Controls[i].Width;
end;
Result := j;
end;
function GetRight: Integer;
var
i, j: Integer;
begin
with Application.MainForm do
begin
j := ClientWidth;
for i := 0 to ControlCount - 1 do
if Controls[i].Visible and (Controls[i].Align = alRight) and
(Controls[i].Left < j)
then
j := Controls[i].Left;
end;
Result := j;
end;
begin
if Application.MainForm <> nil then
Result := Rect(GetLeft, GetTop, GetRight, GetBottom);
end;
procedure TbsBusinessSkinForm.TrayIconDBLCLK;
begin
RestoreFromTray;
end;
procedure TbsBusinessSkinForm.MinimizeToTray;
begin
if FTrayIcon <> nil
then
with FTrayIcon do
begin
FTrayIcon.MinimizeToTray := True;
Application.Minimize;
if Assigned(FOnMinimizeToTray) then FOnMinimizeToTray(Self);
end;
end;
procedure TbsBusinessSkinForm.RestoreFromTray;
begin
if FTrayIcon <> nil
then
with FTrayIcon do
begin
FTrayIcon.MinimizeToTray := False;
FTrayIcon.ShowMainForm;
Application.Restore;
FTrayIcon.IconVisible := False;
if Assigned(FOnRestoreFromTray) then FOnRestoreFromTray(Self);
end;
end;
procedure TbsBusinessSkinForm.SetTrayIcon;
begin
FTrayIcon := Value;
if TrayIcon <> nil
then
with TrayIcon do
begin
IconVisible := False;
MinimizeToTray := False;
if not (csDesigning in ComponentState)
then
begin
if PopupMenu = nil
then
begin
PopupMenu := FSysTrayMenu;
OnDblClick := TrayIconDBLCLK;
end;
end;
end;
end;
procedure TbsBusinessSkinForm.TSM_Restore(Sender: TObject);
begin
RestoreFromTray;
end;
procedure TbsBusinessSkinForm.TSM_Close(Sender: TObject);
begin
FForm.Close;
end;
procedure TbsBusinessSkinForm.SM_Restore(Sender: TObject);
begin
if MaxRollUpState or (FRollUpState and (WindowState = wsNormal))
then
RollUpState := False
else
WindowState := wsNormal;
end;
procedure TbsBusinessSkinForm.SM_Max(Sender: TObject);
begin
WindowState := wsMaximized;
end;
procedure TbsBusinessSkinForm.SM_Min(Sender: TObject);
begin
WindowState := wsMinimized;
end;
procedure TbsBusinessSkinForm.SM_RollUp(Sender: TObject);
begin
RollUpState := True;
end;
procedure TbsBusinessSkinForm.SM_Close(Sender: TObject);
begin
FForm.Close;
end;
procedure TbsBusinessSkinForm.SM_MinToTray(Sender: TObject);
begin
MinimizeToTray;
end;
procedure TbsBusinessSkinForm.CreateUserSysMenu;
procedure AddMaxItem;
var
MI: TMenuItem;
begin
if not (biMaximize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MAXName;
Caption := MI_MAXCAPTION;
OnClick := SM_Max;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddMinItem;
var
MI: TMenuItem;
begin
if not (biMinimize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINName;
Caption := MI_MINCAPTION;
OnClick := SM_Min;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddRestoreItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_RESTOREName;
Caption := MI_RESTORECAPTION;
OnClick := SM_Restore;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddRollUpItem;
var
MI: TMenuItem;
begin
if not (biRollUp in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_ROLLUPName;
Caption := MI_ROLLUPCAPTION;
OnClick := SM_RollUp;
end;
FSystemMenu.Items.Insert(0, MI);
end;
procedure AddCloseItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_CLOSEName;
Caption := MI_CLOSECAPTION;
OnClick := SM_Close;
if FForm.FormStyle = fsMDIChild
then
ShortCut := TextToShortCut('Ctrl+F4')
else
ShortCut := TextToShortCut('Alt+F4');
end;
FSystemMenu.Items.Add(MI);
end;
procedure AddMinToTrayItem;
var
MI: TMenuItem;
begin
if not (biMinimizeToTray in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINTOTRAYName;
Caption := MI_MINTOTRAYCAPTION;
OnClick := SM_MinToTray;
end;
FSystemMenu.Items.Insert(0, MI);
end;
var
B: Boolean;
i: Integer;
begin
if not FUseDefaultSysMenu then Exit;
// delete old items
repeat
B := True;
for i := 0 to FSystemMenu.Items.Count - 1 do
if (FSystemMenu.Items[i].Name = MI_MINName) or
(FSystemMenu.Items[i].Name = MI_MAXName) or
(FSystemMenu.Items[i].Name = MI_CLOSEName) or
(FSystemMenu.Items[i].Name = MI_MINTOTRAYName) or
(FSystemMenu.Items[i].Name = MI_ROLLUPName) or
(FSystemMenu.Items[i].Name = MI_RESTOREName)
then
begin
FSystemMenu.Items[i].Free;
B := False;
Break;
end;
until B;
//
AddMinToTrayItem;
if not ((FForm.FormStyle = fsMDIChild) and (FWindowState = wsMaximized))
then
if not FRollUpState and (FWindowState <> wsMinimized)
then AddRollUpItem;
if FWindowState <> wsMaximized then AddMaxItem;
if (FWindowState <> wsNormal) or FRollUpState then AddRestoreItem;
if FWindowState <> wsMinimized then AddMinItem;
AddCloseItem;
end;
function TbsBusinessSkinForm.GetSystemMenu;
begin
if FSystemMenu <> nil
then
begin
CreateUserSysMenu;
Result := FSystemMenu.Items;
end
else
begin
CreateSysMenu;
Result := FSysMenu.Items;
end;
end;
procedure TbsBusinessSkinForm.CreateSysTrayMenu;
procedure AddRestoreItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := TMI_RESTOREName;
Caption := MI_RESTORECAPTION;
OnClick := TSM_Restore;
end;
FSysTrayMenu.Items.Add(MI);
end;
procedure AddCloseItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := TMI_CLOSEName;
Caption := MI_CLOSECAPTION;
OnClick := TSM_Close;
if FForm.FormStyle = fsMDIChild
then
ShortCut := TextToShortCut('Ctrl+F4')
else
ShortCut := TextToShortCut('Alt+F4');
end;
FSysTrayMenu.Items.Add(MI);
end;
procedure AddDevItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
MI.Caption := '-';
FSysTrayMenu.Items.Add(MI);
end;
begin
AddRestoreItem;
AddDevItem;
AddCloseItem;
end;
procedure TbsBusinessSkinForm.CreateSysMenu;
procedure AddMaxItem;
var
MI: TMenuItem;
begin
if not (biMaximize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MAXName;
Caption := MI_MAXCAPTION;
OnClick := SM_Max;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddMinItem;
var
MI: TMenuItem;
begin
if not (biMinimize in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINName;
Caption := MI_MINCAPTION;
OnClick := SM_Min;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddRestoreItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_RESTOREName;
Caption := MI_RESTORECAPTION;
OnClick := SM_Restore;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddRollUpItem;
var
MI: TMenuItem;
begin
if not (biRollUp in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_ROLLUPName;
Caption := MI_ROLLUPCAPTION;
OnClick := SM_RollUp;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddCloseItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_CLOSEName;
Caption := MI_CLOSECAPTION;
OnClick := SM_Close;
if FForm.FormStyle = fsMDIChild
then
ShortCut := TextToShortCut('Ctrl+F4')
else
ShortCut := TextToShortCut('Alt+F4');
end;
FSysMenu.Items.Add(MI);
end;
procedure AddMinToTrayItem;
var
MI: TMenuItem;
begin
if not (biMinimizeToTray in FBorderIcons) then Exit;
MI := TMenuItem.Create(Self);
with MI do
begin
Name := MI_MINTOTRAYName;
Caption := MI_MINTOTRAYCAPTION;
OnClick := SM_MinToTray;
end;
FSysMenu.Items.Add(MI);
end;
procedure AddDevItem;
var
MI: TMenuItem;
begin
MI := TMenuItem.Create(Self);
MI.Caption := '-';
FSysMenu.Items.Add(MI);
end;
var
i: Integer;
begin
for i := FSysMenu.Items.Count - 1 downto 0 do
TMenuItem(FSysMenu.Items[i]).Free;
if FWindowState <> wsMinimized then AddMinItem;
if FWindowState <> wsMaximized then AddMaxItem;
if (FWindowState <> wsNormal) or FRollUpState then AddRestoreItem;
if not ((FForm.FormStyle = fsMDIChild) and (FWindowState = wsMaximized))
then
if not FRollUpState and (FWindowState <> wsMinimized)
then AddRollUpItem;
AddMinToTrayItem;
if FSysMenu.Items.Count > 0 then AddDevItem;
AddCloseItem;
end;
function TbsBusinessSkinForm.GetFullDragg: Boolean;
var
B: Boolean;
begin
SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @B, 0);
Result := B;
end;
function TbsBusinessSkinForm.GetMinimizeCoord;
function GetMDIEqualCoord(P: TPoint): Boolean;
var
BS: TbsBusinessSkinForm;
MF: TForm;
i: Integer;
begin
Result := True;
MF := Application.MainForm;
for i := 0 to MF.MDIChildCount - 1 do
if (MF.MDIChildren[i] <> FForm) and MF.MDIChildren[i].Visible
then
begin
BS := GetBusinessSkinFormComponent(MF.MDIChildren[i]);
if (BS <> nil) and (BS.WindowState = wsMinimized) and
(MF.MDIChildren[i].Left = P.X) and (MF.MDIChildren[i].Top = P.Y)
then
begin
Result := False;
Break;
end;
end;
end;
function GetSDIEqualCoord(P: TPoint): Boolean;
var
BS: TbsBusinessSkinForm;
i: Integer;
begin
Result := True;
for i := 0 to Screen.FormCount - 1 do
if (Screen.Forms[i] <> FForm) and (Screen.Forms[i] <> Application.MainForm) and
(Screen.Forms[i].Visible)
then
begin
BS := GetBusinessSkinFormComponent(Screen.Forms[i]);
if (BS <> nil) and (BS.WindowState = wsMinimized) and
(Screen.Forms[i].Left = P.X) and (Screen.Forms[i].Top = P.Y)
then
begin
Result := False;
Break;
end;
end;
end;
var
R: TRect;
P: TPoint;
MW, MH, W, H: Integer;
B: Boolean;
begin
P := Point(0, 0);
MW := GetMinWidth;
MH := GetMinHeight;
if FForm.FormStyle = fsMDIChild
then
begin
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
P.Y := H - MH;
P.X := 0;
repeat
B := GetMDIEqualCoord(P);
if not B
then
begin
P.X := P.X + MW;
if P.X + MW > W
then
begin
P.X := 0;
P.Y := P.Y - MH;
if P.Y < 0
then
begin
P.Y := H - MH;
B := True;
end;
end;
end;
until B;
end
else
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
P.Y := R.Bottom - MH;
P.X := R.Left;
repeat
B := GetSDIEqualCoord(P);
if not B
then
begin
P.X := P.X + MW;
if P.X + MW > R.Bottom
then
begin
P.X := R.Left;
P.Y := P.Y - MH;
if P.Y < R.Top
then
begin
P.Y := R.Bottom - MH;
B := True;
end;
end;
end;
until B;
end;
Result := P;
end;
function TbsBusinessSkinForm.GetMinWidth: Integer;
begin
if FSkinSupport
then
begin
if (FMinWidth > FSD.FPicture.Width) and
not (FWindowState = wsMinimized)
then Result := FMinWidth
else Result := FSD.FPicture.Width;
end
else
begin
if FMinWidth > 0
then Result := FMinWidth
else Result := DEFFORMMINWIDTH;
end;
end;
function TbsBusinessSkinForm.GetMinHeight: Integer;
begin
if FSkinSupport
then
begin
if (FMinHeight > FSD.FPicture.Height - RectHeight(FSD.ClRect))
and not FRollUpState
and not (FWindowState = wsMinimized)
then Result := FMinHeight
else Result := FSD.FPicture.Height - RectHeight(FSD.ClRect);
end
else
begin
if (FMinHeight > GetDefCaptionHeight + 6)
and not FRollUpState
and not (FWindowState = wsMinimized)
then Result := FMinHeight
else Result := GetDefCaptionHeight + 6;
end;
end;
function TbsBusinessSkinForm.GetMaxWidth: Integer;
var
R: TRect;
begin
if not FMaximizeOnFullScreen
then
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
Result := RectWidth(R);
end
else
Result := Screen.Width;
end;
function TbsBusinessSkinForm.GetMaxHeight: Integer;
var
R: TRect;
begin
if not FMaximizeOnFullScreen
then
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
Result := Rectheight(R);
end
else
Result := Screen.Height;
end;
procedure TbsBusinessSkinForm.DrawSkinObject;
var
DC: HDC;
Cnvs: TControlCanvas;
begin
if not(((WindowState = wsMaximized) and (FForm.FormStyle = fsMDIChild))
or (FForm.BorderStyle = bsNone))
then
begin
DC := GetWindowDC(FForm.Handle);
Cnvs := TControlCanvas.Create;
Cnvs.Handle := DC;
//
AObject.Draw(Cnvs, True);
//
Cnvs.Handle := 0;
ReleaseDC(FForm.Handle, DC);
Cnvs.Free;
end;
end;
procedure TbsBusinessSkinForm.PointToNCPoint(var P: TPoint);
begin
if FForm.FormStyle = fsMDIChild
then
begin
P := FForm.ScreenToClient(P);
if FSkinSupport
then
begin
P.X := P.X + NewClRect.Left;
P.Y := P.Y + NewClRect.Top;
end
else
begin
P.X := P.X + 3;
P.Y := P.Y + GetDefCaptionHeight + 3;
end;
end
else
begin
P.X := P.X - FForm.Left;
P.Y := P.Y - FForm.Top;
end;
end;
procedure TbsBusinessSkinForm.PaintNCSkin;
var
CaptionBitMap, LeftBitMap, RightBitMap, BottomBitMap: TBitMap;
DC: HDC;
Cnvs: TCanvas;
TempRect: TRect;
i: Integer;
P: TBitMap;
CEB, LEB, REB, BEB: TbsEffectBmp;
begin
if FFormWidth = 0 then FFormWidth := FForm.Width;
if FFormheight = 0 then FFormHeight := FForm.Height;
if (FFormWidth < GetMinWidth) or (FFormHeight < GetMinHeight) then Exit;
CalcRects;
CalcAllRealObjectRect;
DC := GetWindowDC(FForm.Handle);
Cnvs := TCanvas.Create;
Cnvs.Handle := DC;
CaptionBitMap := TBitMap.Create;
LeftBitMap := TBitMap.Create;
RightBitMap := TBitMap.Create;
BottomBitMap := TBitMap.Create;
if not GetFormActive and not FSD.FInActivePicture.Empty
then
P := FSD.FInActivePicture
else
P := FSD.FPicture;
// crate borderbitmap
with FSD do
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, ClRect,
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftBitMap, CaptionBitMap, RightBitMap, BottomBitMap,
P, Rect(0, 0, P.Width, P.Height), FFormWidth, FFormHeight);
// draw skin objects
for i := 0 to ObjectList.Count - 1 do
with TbsActiveSkinObject(ObjectList.Items[i]) do
if Visible then
begin
if (ObjectRect.Bottom <= NewClRect.Top)
then
Draw(CaptionBitMap.Canvas, False)
else
begin
TempRect := ObjectRect;
OffsetRect(ObjectRect, 0, -NewClRect.Bottom);
Draw(BottomBitMap.Canvas, False);
ObjectRect := TempRect;
end;
end;
//
if NewClRect.Bottom > NewClRect.Top
then
ExcludeClipRect(Cnvs.Handle,
NewClRect.Left, NewClRect.Top, NewClRect.Right, NewClRect.Bottom);
// paint nc
if GetFormActive or not GetAutoRenderingInActiveImage
then
begin
Cnvs.Draw(0, 0, CaptionBitMap);
Cnvs.Draw(0, CaptionBitMap.Height, LeftBitMap);
Cnvs.Draw(FFormWidth - RightBitMap.Width, CaptionBitMap.Height, RightBitMap);
Cnvs.Draw(0, FFormHeight - BottomBitMap.Height, BottomBitMap);
end
else
begin
CEB := TbsEffectBmp.CreateFromhWnd(CaptionBitMap.Handle);
LEB := TbsEffectBmp.CreateFromhWnd(LeftBitMap.Handle);
REB := TbsEffectBmp.CreateFromhWnd(RightBitMap.Handle);
BEB := TbsEffectBmp.CreateFromhWnd(BottomBitMap.Handle);
case FSD.InActiveEffect of
ieBrightness:
begin
CEB.ChangeBrightness(InActiveBrightnessKf);
LEB.ChangeBrightness(InActiveBrightnessKf);
REB.ChangeBrightness(InActiveBrightnessKf);
BEB.ChangeBrightness(InActiveBrightnessKf);
end;
ieDarkness:
begin
CEB.ChangeDarkness(InActiveDarknessKf);
LEB.ChangeDarkness(InActiveDarknessKf);
REB.ChangeDarkness(InActiveDarknessKf);
BEB.ChangeDarkness(InActiveDarknessKf);
end;
ieGrayScale:
begin
CEB.GrayScale;
LEB.GrayScale;
REB.GrayScale;
BEB.GrayScale;
end;
ieNoise:
begin
CEB.AddMonoNoise(InActiveNoiseAmount);
LEB.AddMonoNoise(InActiveNoiseAmount);
REB.AddMonoNoise(InActiveNoiseAmount);
BEB.AddMonoNoise(InActiveNoiseAmount);
end;
ieSplitBlur:
begin
CEB.SplitBlur(1);
LEB.SplitBlur(1);
REB.SplitBlur(1);
BEB.SplitBlur(1);
end;
ieInvert:
begin
CEB.Invert;
LEB.Invert;
REB.Invert;
BEB.Invert;
end;
end;
CEB.Draw(Cnvs.Handle, 0, 0);
LEB.Draw(Cnvs.Handle, 0, CaptionBitMap.Height);
REB.Draw(Cnvs.Handle, FFormWidth - RightBitMap.Width, CaptionBitMap.Height);
BEB.Draw(Cnvs.Handle, 0, FFormHeight - BottomBitMap.Height);
CEB.Free;
LEB.Free;
REB.Free;
BEB.Free;
end;
//
BottomBitMap.Free;
RightBitMap.Free;
LeftBitMap.Free;
CaptionBitMap.Free;
ReleaseDC(FForm.Handle, DC);
Cnvs.Handle := 0;
Cnvs.Free;
end;
procedure TbsBusinessSkinForm.FormShortCut;
var
MM: TMainMenu;
begin
if FInShortCut
then
begin
FInShortCut := False;
Handled := False;
Exit;
end;
if (FMainMenuBar <> nil) and (FMainMenuBar.MainMenu <> nil)
then
MM := FMainMenuBar.MainMenu
else
MM := FMainMenu;
if MM <> nil
then
if (KeyDataToShiftState(Msg.KeyData) = [ssAlt]) and FindHotKeyItem(Msg.CharCode)
then
Handled := True
else
begin
FInShortCut := MM.IsShortCut(Msg);
if FInShortCut then Handled := True else Handled := False;
end;
end;
procedure TbsBusinessSkinForm.SetFormStyle;
begin
if (FS = fsNormal) or (FS = fsStayOnTop)
then
begin
FForm.FormStyle := FS;
UpDateSkinControls(0, FForm);
end;
end;
procedure TbsBusinessSkinForm.CreateRollUpForm;
begin
FForm.Height := GetMinHeight;
end;
procedure TbsBusinessSkinForm.RestoreRollUpForm;
begin
FForm.Height := OldHeight;
end;
procedure TbsBusinessSkinForm.SetRollUpState;
begin
if not (biRollUp in FBorderIcons) or
(FRollUpState and (FWindowState = wsMaximized) and not MaxRollUpState) or
(FWindowState = wsMinimized)
then Exit;
if WindowState = wsMaximized then MaxRollUpState := Value;
FRollUpState := Value;
if FRollUpState
then
begin
OldHeight := FForm.Height;
CreateRollUpForm;
end
else
RestoreRollUpForm;
if Assigned(FOnChangeRollUpState) then FOnChangeRollUpState(Self);
end;
procedure TbsBusinessSkinForm.BeforeUpDateSkinControls;
procedure CheckControl(C: TControl);
begin
if C is TbsSkinControl
then
begin
with TbsSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then BeforeChangeSkinData;
end;
end;
var
i: Integer;
begin
CheckControl(WC);
for i := 0 to WC.ControlCount - 1 do
begin
if WC.Controls[i] is TWinControl
then
BeforeUpDateSkinControls(AFSD, TWinControl(WC.Controls[i]))
else
CheckControl(WC.Controls[i]);
end;
end;
procedure TbsBusinessSkinForm.UpDateSkinControls;
procedure CheckControl(C: TControl);
begin
if C is TbsSkinControl
then
begin
with TbsSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TbsGraphicSkinControl
then
begin
with TbsGraphicSkinControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TbsSkinPageControl
then
begin
with TbsSkinPageControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TbsSkinTabControl
then
begin
with TbsSkinTabControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData
end
else
if C is TbsSkinCustomEdit
then
begin
with TbsSkinEdit(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinMemo
then
begin
with TbsSkinMemo(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinMemo2
then
begin
with TbsSkinMemo2(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinStdLabel
then
begin
with TbsSkinStdLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinLinkLabel
then
begin
with TbsSkinLinkLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinButtonLabel
then
begin
with TbsSkinButtonLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinTextLabel
then
begin
with TbsSkinTextLabel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinCustomTreeView
then
begin
with TbsSkinTreeView(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then ChangeSkinData;
end
else
if C is TbsSkinBevel
then
begin
with TbsSkinBevel(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then ChangeSkinData;
end
else
if C is TbsSkinCustomListView
then
begin
with TbsSkinListView(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then ChangeSkinData;
end
else
if C is TbsSkinHeaderControl
then
begin
with TbsSkinHeaderControl(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then ChangeSkinData;
end
else
if C is TbsSkinRichEdit
then
begin
with TbsSkinRichEdit(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0)
then ChangeSkinData;
end
else
if C is TbsSkinControlBar
then
begin
with TbsSkinControlBar(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end
else
if C is TbsSkinSplitter
then
begin
with TbsSkinSplitter(C) do
if (Integer(SkinData) = AFSD) or (AFSD = 0) then ChangeSkinData;
end;
end;
var
i: Integer;
begin
CheckControl(WC);
for i := 0 to WC.ControlCount - 1 do
begin
if WC.Controls[i] is TWinControl
then
UpDateSkinControls(AFSD, TWinControl(WC.Controls[i]))
else
CheckControl(WC.Controls[i]);
end;
end;
procedure TbsBusinessSkinForm.PopupSkinMenu;
var
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 TbsBusinessSkinForm.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 TbsBusinessSkinForm.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 TbsBusinessSkinForm.SkinMainMenuClose;
begin
InMainMenu := False;
if SkinMenu.Visible then SkinMenu.Hide;
if FMainMenuBar <> nil
then
FMainMenuBar.MenuExit;
UnHookApp;
if Assigned(FOnMainMenuExit) then FOnMainMenuExit(Self);
end;
procedure TbsBusinessSkinForm.SkinMenuClose2;
begin
InMenu := False;
if FMainMenuBar <> nil
then
FMainMenuBar.MenuClose;
if Assigned(FOnSkinMenuClose) then FOnSkinMenuClose(Self);
end;
procedure TbsBusinessSkinForm.SkinMenuClose;
var
i: Integer;
begin
InMenu := False;
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinButtonObject then
begin
with TbsSkinButtonObject (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 TbsBusinessSkinForm.CheckObjects;
var
i: Integer;
begin
if ObjectList.Count > 0 then
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinStdButtonObject
then
with TbsSkinStdButtonObject(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;
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
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0)
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: 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
SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0)
else
R := Rect(0, 0, Screen.Width, Screen.Height);
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;
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
CreateNewRegion(True);
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;
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 = 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;
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 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;
B: Boolean;
begin
if not GetFormActive then Exit;
GetCursorPos(P);
B := InForm(P);
if not B
then
begin
TestActive(-1, -1, False);
MouseTimer.Enabled := False;
end
else
if not FSizeMove then
begin
PointToNCPoint(P);
if not PtInRect(NewClRect, P)
then
TestActive(P.X, P.Y, B)
else
if ActiveObject <> -1 then TestActive(-1, -1, True);
end;
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: TbsSkinStdButtonObject;
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): TbsSkinStdButtonObject;
var
I: Integer;
begin
Result := nil;
for I := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[I]) is TbsSkinStdButtonObject
then
with TbsSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TbsSkinStdButtonObject(ObjectList.Items[I]);
Break;
end;
end;
procedure SetStdButtonRect(B: TbsSkinStdButtonObject);
begin
if B <> nil
then
with 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;
procedure SetStdButtonRect2(B: TbsSkinStdButtonObject);
begin
if B <> nil
then
with 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;
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 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;
C.Free;
end;
procedure TbsBusinessSkinForm.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;
C.Draw(0, 0, BGImage);
BGImage.Free;
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)
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;
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;
end;
WM_NCPAINT:
begin
FOld := False;
end;
WM_ERASEBKGND:
begin
FOld := False;
if (FSD <> nil) and not FSD.Empty
then
begin
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_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
UpDateChildCaptionInMenu(FForm);
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, 3);
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 AddChildToMenu(FForm);
//
if FForm.Menu <> nil then FForm.Menu := nil;
end
else
begin
if FForm.FormStyle = fsMDIChild then DeleteChildFromMenu(FForm);
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 := 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;
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:
begin
FSizeMove := True;
FFullDrag := GetFullDragg;
end;
WM_EXITSIZEMOVE:
begin
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;
end;
WM_DESTROY:
begin
MouseTimer.Enabled := False;
MorphTimer.Enabled := False;
if (FForm.FormStyle = fsMDIChild)
then
begin
FWindowState := wsNormal;
SendMessage(Application.MainForm.Handle, WM_MDICHILDRESTORE, 0, 0);
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;
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;
end;
WM_ERASEBKGND:
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 := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseMove(P.X, P.Y);
end;
WM_NCLBUTTONDBLCLK:
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 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 := 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:
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;
WM_NCLBUTTONUP:
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseUp(mbLeft, LoWord(LParam), HiWord(LParam));
end;
WM_NCRBUTTONDOWN:
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:
begin
P.X := LoWord(lParam);
P.Y := HiWord(lParam);
PointToNCPoint(P);
MouseUp(mbRight, P.X, P.Y);
end;
end;
end;
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.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 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 (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;
end.