Delphi控件源码

开发平台：

Delphi

BusinessSkinForm.pas：源码内容

ActiveObject := -1;
MouseCaptureObject := -1;
TbsMenuBarObject(ObjectList.Items[0]).Free;
ObjectList.Delete(0);
end;
ButtonsCount := 0;
end;
procedure TbsSkinMainMenuBar.MDIChildMaximize;
var
BS: TbsBusinessSkinForm;
begin
if not FMDIChildMax
then
begin
FMDIChildMax := True;
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
AddButtons;
BS := GetMDIChildBusinessSkinFormComponent;
if BS <> nil then CheckButtons(BS.BorderIcons);
RePaint;
end;
end;
procedure TbsSkinMainMenuBar.MDIChildRestore;
var
BS: TbsBusinessSkinForm;
begin
BS := GetMDIChildBusinessSkinFormComponent;
if (BS = nil) and FMDIChildMax
then
begin
FMDIChildMax := False;
DeleteButtons;
RePaint;
end
else
if BS <> nil
then CheckButtons(BS.BorderIcons);
end;
function TbsSkinMainMenuBar.GetMarkerRect;
begin
Result := Rect(NewItemsRect.Right - TRACKMARKEROFFSET, NewItemsRect.Top,
NewItemsRect.Right, NewItemsRect.Bottom);
end;
procedure TbsSkinMainMenuBar.DrawMarker;
var
C: TColor;
begin
if FIndex <> -1
then
begin
if MarkerActive
then C := TrackMarkActiveColor
else C := TrackMarkColor;
end
else
begin
if MarkerActive
then C := clBtnText
else C := clBtnShadow;
end;
DrawArrowImage(Cnvs, GetMarkerRect, C, 2);
end;
procedure TbsSkinMainMenuBar.TrackScrollMenu;
var
i, VisibleCount: Integer;
R: TRect;
P: TPoint;
ChildMainMenu: TMainMenu;
begin
if BSF = nil then Exit;
VisibleCount := 0;
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Visible then Inc(VisibleCount);
end;
P := Point(NewItemsRect.Right, NewItemsRect.Top);
P := ClientToScreen(P);
R := Rect(P.X - TRACKMARKEROFFSET, P.Y,
P.X, P.Y + RectHeight(NewItemsRect));
if BSF.FForm.FormStyle = fsMDIForm
then
ChildMainMenu := GetChildMainMenu
else
ChildMainMenu := nil;
BSF.SkinMenuOpen;
if ChildMainMenu = nil
then
BSF.SkinMenu.Popup(nil, FSD, VisibleCount, R, FMainMenu.Items, False)
else
BSF.SkinMenu.Popup2(nil, FSD, VisibleCount, R, FMainMenu.Items, ChildMainMenu.Items, False);
end;
function TbsSkinMainMenuBar.FindHotKeyItem;
var
i: Integer;
begin
Result := False;
if (BSF <> nil) and (ObjectList <> nil) then
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible and
IsAccel(CharCode, MenuItem.Caption)
then
begin
MouseEnter;
if (not BSF.InMenu) or (MenuItem.Count = 0) then MouseDown(0, 0, mbLeft);
Result := True;
Break;
end;
end
end;
procedure TbsSkinMainMenuBar.NextMainMenuItem;
function IsEndItem(Index: Integer): Boolean;
var
i: Integer;
begin
Result := True;
if Index + 1 > ObjectList.Count - 1
then
Result := True
else
for i := Index + 1 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible then Result := False;
end
end;
var
i, j: Integer;
EndI: Boolean;
FirstItem: Integer;
begin
EndI := False;
FirstItem := -1;
j := -1;
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
if FirstItem = -1 then FirstItem := i;
if (Active or FDown)
then
begin
j := i;
MouseLeave;
EndI := IsEndItem(j);
Break;
end;
end;
end;
if j = -1
then
begin
j := FirstItem;
if j <> -1 then
TbsSkinMainMenuBarItem(ObjectList.Items[j]).MouseEnter;
end
else
begin
if EndI then j := 0 else j := j + 1;
if j < ObjectList.Count then
for i := j to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
MouseEnter;
Break;
end;
end;
end;
end;
procedure TbsSkinMainMenuBar.PriorMainMenuItem;
function IsEndItem(Index: Integer): Boolean;
var
i: Integer;
begin
Result := True;
if Index - 1 < 0
then
Result := True
else
for i := Index - 1 downto 0 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible then Result := False;
end
end;
var
i, j: Integer;
EndI: Boolean;
LastItem: Integer;
begin
EndI := False;
j := -1;
LastItem := -1;
for i := ObjectList.Count - 1 downto 0 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
if LastItem = -1 then LastItem := i;
if Active or FDown then
begin
j := i;
MouseLeave;
EndI := IsEndItem(j);
Break;
end;
end;
end;
if j = -1
then
begin
j := LastItem;
if j <> -1 then
TbsSkinMainMenuBarItem(ObjectList.Items[j]).MouseEnter;
end
else
begin
if EndI then j := ObjectList.Count - 1 else j := j - 1;
if j > -1 then
for i := j downto 0 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if Enabled and Visible
then
begin
MouseEnter;
Break;
end;
end;
end;
end;
function TbsSkinMainMenuBar.CheckReturnKey;
var
i: Integer;
begin
Result := False;
if BSF <> nil then
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if (FDown and (MenuItem.Count = 0)) or
(Active and not BSF.InMenu)
then
begin
Active := False;
MouseDown(0, 0, mbLeft);
Result := True;
Break;
end;
end;
end;
procedure TbsSkinMainMenuBar.MenuEnter;
var
i: Integer;
FirstItem: Integer;
begin
FirstItem := -1;
MenuActive := True;
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem
then
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
begin
if FirstItem = -1 then FirstItem := i;
if Active
then
begin
FirstItem := i;
Break;
end;
end;
if FirstItem <> -1
then
begin
TbsSkinMainMenuBarItem(ObjectList.Items[FirstItem]).MouseEnter;
if BSF <> nil then
with BSF do
begin
HookApp;
InMainMenu := True;
if Assigned(OnMainMenuEnter) then OnMainMenuEnter(Self);
end;
end;
end;
procedure TbsSkinMainMenuBar.MenuClose;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem then
begin
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
if FDown then
begin
FDown := False;
Active := True;
DrawSkinObject(TbsSkinMainMenuBarItem(ObjectList.Items[i]));
Break;
end;
end;
end;
procedure TbsSkinMainMenuBar.MenuExit;
var
i: Integer;
begin
MenuActive := False;
for i := 0 to ObjectList.Count - 1 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarItem then
begin
with TbsSkinMainMenuBarItem(ObjectList.Items[i]) do
if FDown or Active then
begin
Active := False;
FMouseIn := False;
FDown := False;
ReDraw;
Break;
end;
end;
ActiveObject := -1;
OldActiveObject := -1;
end;
procedure TbsSkinMainMenuBar.CalcRects;
var
Off: Integer;
i: Integer;
begin
if FSkinSupport
then
begin
Off := RectWidth(SkinRect) - ItemsRect.Right;
NewItemsRect := Rect(ItemsRect.Left, ItemsRect.Top, Width - Off, ItemsRect.Bottom);
end
else
NewItemsRect := Rect(2, 2, Width - 2, Height - 2);
if FMDIChildMax and (ButtonsCount = 4)
then
begin
if TbsMenuBarObject(ObjectList.Items[0]) is TbsSkinMainMenuBarButton
then
with TbsSkinMainMenuBarButton((ObjectList.Items[0])) do
begin
if FSkinSupport
then
begin
ObjectRect := Rect(NewItemsRect.Left,
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2,
NewItemsRect.Left + RectWidth(SkinRect),
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2 +
RectHeight(SkinRect));
Inc(NewItemsRect.Left, RectWidth(SkinRect) + 2);
end
else
begin
ObjectRect := Rect(NewItemsRect.Left,
NewItemsRect.Top,
NewItemsRect.Left + RectHeight(NewItemsRect),
NewItemsRect.Bottom);
Inc(NewItemsRect.Left, RectHeight(NewItemsRect) + 2);
end;
end;
for i := 1 to 3 do
if TbsMenuBarObject(ObjectList.Items[i]) is TbsSkinMainMenuBarButton
then
with TbsSkinMainMenuBarButton((ObjectList.Items[i])) do
begin
if FSkinSupport
then
begin
ObjectRect := Rect(NewItemsRect.Right - RectWidth(SkinRect),
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2,
NewItemsRect.Right,
NewItemsRect.Top +
RectHeight(NewItemsRect) div 2 - RectHeight(SkinRect) div 2 +
RectHeight(SkinRect));
Dec(NewItemsRect.Right, RectWidth(SkinRect) + 2);
end
else
begin
ObjectRect := Rect(NewItemsRect.Right - RectHeight(NewItemsRect),
NewItemsRect.Top,
NewItemsRect.Right,
NewItemsRect.Bottom);
Dec(NewItemsRect.Right, RectHeight(NewItemsRect) + 2);
end;
end;
end;
end;
procedure TbsSkinMainMenuBar.DrawSkinObject;
begin
if AObject.Visible then AObject.Draw(Canvas);
end;
procedure TbsSkinMainMenuBar.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMainMenuBar
then
with TbsDataSkinMainMenuBar(FSD.CtrlList.Items[FIndex]) do
begin
Self.SkinRect := SkinRect;
Self.ItemsRect := ItemsRect;
Self.MenuBarItem := MenuBarItem;
Self.CloseButton := CloseButton;
Self.MaxButton := MaxButton;
Self.MinButton := MinButton;
Self.SysMenuButton := SysMenuButton;
Self.TrackMarkColor := TrackMarkColor;
Self.TrackMarkActiveColor := TrackMarkActiveColor;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
end;
end;
procedure TbsSkinMainMenuBar.WMSize;
begin
inherited;
CalcRects;
end;
function TbsSkinMainMenuBar.GetChildMainMenu: TMainMenu;
var
i: Integer;
begin
Result := nil;
if (Application.MainForm <> nil) and (Application.MainForm.ActiveMDIChild <> nil)
then
with Application.MainForm.ActiveMDIChild do
begin
for i := 0 to ComponentCount - 1 do
begin
if Components[i] is TMainMenu
then
begin
Result := TMainMenu(Components[i]);
Break;
end;
end;
end;
end;
procedure TbsSkinMainMenuBar.CreateMenu;
function CompareValues(Item1, Item2: Pointer): Integer;
begin
if TMenuItem(Item1).GroupIndex > TMenuItem(Item2).GroupIndex then Result := 1;
if TMenuItem(Item1).GroupIndex = TMenuItem(Item2).GroupIndex then Result := 0;
if TMenuItem(Item1).GroupIndex < TMenuItem(Item2).GroupIndex then Result := -1;
end;
var
i, j: Integer;
MMIData: TbsDataSkinMainMenuBarItem;
BS: TbsBusinessSkinForm;
ChildMainMenu: TMainMenu;
miL: TList;
HasExist: Boolean;
begin
ClearObjects;
if FMainMenu = nil then Exit;
if (BSF <> nil) and (BSF.FForm.FormStyle = fsMDIForm)
then
ChildMainMenu := GetChildMainMenu
else
ChildMainMenu := nil;
if (FSD = nil) or (FSD.Empty)
then
MMIData := nil
else
begin
j := FSD.GetIndex(MenuBarItem);
if j <> -1
then MMIData := TbsDataSkinMainMenuBarItem(FSD.ObjectList.Items[j])
else MMIData := nil;
end;
ChildMenuIn := ChildMainMenu <> nil;
if ChildMenuIn and ScrollMenu then ScrollMenu := False;
if ChildMainMenu = nil
then
begin
for i := 0 to FMainMenu.Items.Count - 1 do
if FMainMenu.Items[i].Visible
then
begin
ObjectList.Add(TbsSkinMainMenuBarItem.Create(Self, MMIData));
with TbsSkinMainMenuBarItem(ObjectList.Items[ObjectList.Count - 1]) do
begin
IDName := FMainMenu.Items[i].Name;
Enabled := FMainMenu.Items[i].Enabled;
MenuItem := FMainMenu.Items[i];
end;
end;
end
else
begin
miL := TList.Create;
for i := 0 to FMainMenu.Items.Count - 1 do
begin
HasExist := False;
for j := 0 to ChildMainMenu.Items.Count - 1 do
begin
if ChildMainMenu.Items[j].GroupIndex = FMainMenu.Items[i].GroupIndex
then
begin
HasExist := True;
Break;
end;
end;
if not HasExist then miL.Add(FMainMenu.Items[i]);
end;
for i := 0 to ChildMainMenu.Items.Count - 1 do
miL.Add(ChildMainMenu.Items[I]);
miL.Sort(@CompareValues);
for i := 0 to miL.Count - 1 do
if TMenuItem(miL.Items[i]).Visible
then
begin
ObjectList.Add(TbsSkinMainMenuBarItem.Create(Self, MMIData));
with TbsSkinMainMenuBarItem(ObjectList.Items[ObjectList.Count - 1]) do
begin
IDName := TMenuItem(miL.Items[i]).Name;
Enabled := TMenuItem(miL.Items[i]).Enabled;
MenuItem := TMenuItem(miL.Items[i]);
end;
end;
miL.Free;
end;
if Self.FMDIChildMax
then
begin
AddButtons;
BS := GetMDIChildBusinessSkinFormComponent;
if BS <> nil then CheckButtons(BS.BorderIcons);
end;
end;
procedure TbsSkinMainMenuBar.SetMainMenu;
begin
FMainMenu := Value;
CreateMenu;
RePaint;
end;
procedure TbsSkinMainMenuBar.UpDateItems;
begin
CreateMenu;
RePaint;
ActiveObject := -1;
OldActiveObject := -1;
MouseTimer.Enabled := True;
end;
procedure TbsSkinMainMenuBar.ClearObjects;
var
i: Integer;
begin
for i := 0 to ObjectList.Count - 1 do
TbsMenuBarObject(ObjectList.Items[i]).Free;
ObjectList.Clear;
ButtonsCount := 0;
end;
procedure TbsSkinMainMenuBar.CMMouseEnter;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
MouseTimer.Enabled := True;
end;
procedure TbsSkinMainMenuBar.CMMouseLeave;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
MouseTimer.Enabled := False;
TestActive(-1, -1);
end;
procedure TbsSkinMainMenuBar.MouseDown;
begin
inherited;
TestActive(X, Y);
if (ActiveObject <> - 1)
then
with TbsMenuBarObject(ObjectList.Items[ActiveObject]) do
begin
MouseCaptureObject := ActiveObject;
MouseDown(X, Y, Button);
if ssDouble in Shift then DblCLick;
end
else
if Scroll and FScrollMenu
then
begin
if PtInRect(GetMarkerRect, Point(X, Y)) then TrackScrollMenu;
end;
end;
procedure TbsSkinMainMenuBar.MouseUp;
begin
if (MouseCaptureObject <> -1)
then
begin
TbsMenuBarObject(ObjectList.Items[MouseCaptureObject]).MouseUp(X, Y, Button);
MouseCaptureObject := -1;
end;
inherited;
end;
procedure TbsSkinMainMenuBar.MouseMove;
begin
if not MouseTimer.Enabled
then MouseTimer.Enabled := True;
inherited;
end;
procedure TbsSkinMainMenuBar.BeforeChangeSkinData;
begin
FSkinSupport := False;
inherited;
ClearObjects;
end;
procedure TbsSkinMainMenuBar.ChangeSkinData;
begin
GetSkinData;
FSkinSupport := FIndex <> -1;
CreateMenu;
if FSkinSupport
then
Height := RectHeight(SkinRect)
else
if FDefaultHeight > 0 then Height := FDefaultHeight;
RePaint;
end;
procedure TbsSkinMainMenuBar.TestActive;
var
i: Integer;
B: Boolean;
begin
if (ObjectList.Count = 0) then Exit;
OldActiveObject := ActiveObject;
i := -1;
B := False;
repeat
Inc(i);
with TbsMenuBarObject(ObjectList.Items[i]) do
begin
if Enabled then B := PtInRect(ObjectRect, Point(X, Y));
end;
until B or (i = ObjectList.Count - 1);
if not B and (OldActiveObject <> -1) and MenuActive and
(TbsMenuBarObject(ObjectList.Items[OldActiveObject]) is
TbsSkinMainMenuBarItem)
then
ActiveObject := OldActiveObject
else
if B then ActiveObject := i else ActiveObject := -1;
if (MouseCaptureObject <> -1) and
(ActiveObject <> MouseCaptureObject) and (ActiveObject <> -1)
then
ActiveObject := -1;
if OldActiveObject >= ObjectList.Count then OldActiveObject := -1;
if ActiveObject >= ObjectList.Count then ActiveObject := -1;
if (OldActiveObject <> ActiveObject)
then
begin
if OldActiveObject <> - 1
then
if TbsMenuBarObject(ObjectList.Items[OldActiveObject]).Enabled
then TbsMenuBarObject(ObjectList.Items[OldActiveObject]).MouseLeave;
if ActiveObject <> -1
then
if TbsMenuBarObject(ObjectList.Items[ActiveObject]).Enabled
then TbsMenuBarObject(ObjectList.Items[ActiveObject]).MouseEnter;
end;
if Scroll and FScrollMenu
then
begin
if PtInRect(GetMarkerRect, Point(X, Y)) and not MarkerActive
then
begin
MarkerActive := True;
DrawMarker(Canvas);
end
else
if MarkerActive and not PtInRect(GetMarkerRect, Point(X, Y))
then
begin
MarkerActive := False;
DrawMarker(Canvas);
end;
end;
end;
procedure TbsSkinMainMenuBar.TestMouse;
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (P.X >= 0) and (P.Y >= 0) and (P.X <= Width) and (P.Y <= Height)
then
TestActive(P.X, P.Y)
else
if MouseTimer.Enabled
then
begin
MouseTimer.Enabled := False;
TestActive(-1, -1);
end;
end;
procedure TbsSkinMainMenuBar.SetBounds;
begin
GetSkinData;
if FIndex <> -1 then AHeight := RectHeight(SkinRect);
inherited;
RePaint;
end;
procedure TbsSkinMainMenuBar.PaintMenuBar(Cnvs: TCanvas);
var
Buffer: TBitMap;
R: TRect;
i: Integer;
begin
GetSkinData;
Buffer := TBitMap.Create;
R := Rect(0, 0, Width, Height);
if FIndex <> -1
then
begin
CreateHSkinImage(ItemsRect.Left, RectWidth(SkinRect) - ItemsRect.Right,
Buffer, Picture, SkinRect, Width, Height);
end
else
begin
Buffer.Width := Width;
Buffer.Height := Height;
with Buffer.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
CalcRects;
Scroll := False;
for i := 0 to ObjectList.Count - 1 do
with TbsMenuBarObject(ObjectList.Items[i]) do
begin
if Visible then Draw(Buffer.Canvas);
end;
if Scroll and FScrollMenu then DrawMarker(Buffer.Canvas);
Cnvs.Draw(0, 0, Buffer);
Buffer.Free;
end;
procedure TbsSkinMainMenuBar.Paint;
begin
end;
procedure TbsSkinMainMenuBar.WMEraseBkgnd;
var
Cnvs: TCanvas;
begin
Cnvs := TCanvas.Create;
Cnvs.Handle := TWMEraseBkgnd(Message).DC;
PaintMenuBar(Cnvs);
Cnvs.Free;
Message.Result := 1;
end;
procedure TbsSkinMainMenuBar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FMainMenu)
then FMainMenu := nil;
if (Operation = opRemove) and (AComponent = BSF)
then BSF := nil;
end;
//============= TbsBusinessSkinForm =============//
type
TParentForm = class(TForm);
constructor TbsBusinessSkinForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FClientWidth := 0;
FClientHeight := 0;
PreviewMode := False;
FHideCaptionButtons := False;
FAlwaysShowInTray := False;
FLogoBitMap := TBitMap.Create;
FLogoBitMapTransparent := False;
FAlwaysMinimizeToTray := False;
FIcon := nil;
FShowIcon := False;
FMaximizeOnFullScreen := False;
FAlphaBlendAnimation := False;
FAlphaBlend := False;
FAlphaBlendValue := 200;
FSkinHint := nil;
FShowObjectHint := False;
FUseDefaultObjectHint := True;
FSkinSupport := False;
FDefCaptionFont := TFont.Create;
FDefInActiveCaptionFont := TFont.Create;
FMenusAlphaBlend := False;
FMenusAlphaBlendValue := 200;
FMenusAlphaBlendAnimation := False;
with FDefCaptionFont do
begin
Name := 'Arial';
Style := [fsBold];
Height := 14;
Color := clBtnText;
end;
with FDefInActiveCaptionFont do
begin
Name := 'Arial';
Style := [fsBold];
Height := 14;
Color := clBtnShadow;
end;
InMenu := False;
InMainMenu := False;
RMTop := TBitMap.Create;
RMLeft := TBitMap.Create;
RMBottom := TBitMap.Create;
RMRight := TBitMap.Create;
BlackColor := RGB(0, 0, 0);
ObjectList := TList.Create;
FSD := nil;
FMainMenu := nil;
FSystemMenu := nil;
FInChangeSkinData := False;
MouseTimer := TTimer.Create(Self);
MouseTimer.Enabled := False;
MouseTimer.OnTimer := TestMouse;
MouseTimer.Interval := MouseTimerInterval;
MorphTimer := TTimer.Create(Self);
MorphTimer.Enabled := False;
MorphTimer.OnTimer := TestMorph;
MorphTimer.Interval := MorphTimerInterval;
AnimateTimer := TTimer.Create(Self);
AnimateTimer.Enabled := False;
AnimateTimer.OnTimer := TestAnimate;
AnimateTimer.Interval := AnimateTimerInterval;
OldBoundsRect := NulLRect;
OldActiveObject := -1;
ActiveObject := -1;
MouseCaptureObject := -1;
MouseIn := False;
FMinWidth := 0;
FMinHeight := 0;
FRGN := 0;
FClientInstance := nil;
FPrevClientProc := nil;
FForm := TForm(Owner);
FForm.BorderIcons := [];
FForm.OnShortCut := FormShortCut;
FForm.AutoSize := False;
FForm.AutoScroll := False;
FSysMenu := TPopupMenu.Create(Self);
FUseDefaultSysMenu := True;
FSysTrayMenu := TbsSkinPopupMenu.Create(Self);
FSysTrayMenu.ComponentForm := FForm;
CreateSysTrayMenu;
SkinMenu := TbsSkinMenu.CreateEx(Self, FForm);
FMagneticSize := 5;
FBorderIcons := [biSystemMenu, biMinimize, biMaximize, biRollUp];
FFullDrag := False;
FSizeMove := False;
FFormWidth := 0;
FFormHeight := 0;
FMainMenuBar := nil;
FMDITabsBar := nil;
FInShortCut := False;
if not (csDesigning in ComponentState)
then
begin
OldWindowProc := FForm.WindowProc;
FForm.WindowProc := NewWndProc;
TParentForm(FForm).ReCreateWnd;
SetWindowLong(FForm.Handle, GWL_STYLE,
GETWINDOWLONG(FForm.Handle, GWL_STYLE) and not WS_CAPTION);
end;
end;
destructor TbsBusinessSkinForm.Destroy;
begin
if not (csDesigning in ComponentState) and (FForm <> nil)
then
FForm.WindowProc := OldWindowProc;
FDefCaptionFont.Free;
FDefInActiveCaptionFont.Free;
FLogoBitMap.Free;
FSysMenu.Free;
FSysTrayMenu.Free;
ClearObjects;
RMTop.Free;
RMLeft.Free;
RMBottom.Free;
RMRight.Free;
MouseTimer.Free;
MorphTimer.Free;
AnimateTimer.Free;
ObjectList.Free;
SkinMenu.Free;
if FRgn <> 0 then DeleteObject(FRgn);
if FIcon <> nil then FIcon.Free;
inherited Destroy;
end;
function TbsBusinessSkinForm.GetRealHeight;
begin
if Self.RollUpState
then
Result := OldHeight
else
Result := FFormHeight;
end;
procedure TbsBusinessSkinForm.SetLogoBitMap;
begin
FLogoBitMap.Assign(Value);
end;
procedure TbsBusinessSkinForm.DrawLogoBitMap(C: TCanvas);
var
X, Y: Integer;
begin
X := FForm.ClientWidth div 2 - FLogoBitMap.Width div 2;
Y := FForm.ClientHeight div 2 - FLogoBitMap.Height div 2;
if X < 0 then X := 0;
if Y < 0 then Y := 0;
if FLogoBitMap.Transparent <> FLogoBitmapTransparent
then
FLogoBitmap.Transparent := FLogoBitmapTransparent;
C.Draw(X, Y, FLogoBitMap);
end;
function TbsBusinessSkinForm.GetUseSkinFontInMenu: Boolean;
begin
Result := SkinMenu.UseSkinFont;
end;
procedure TbsBusinessSkinForm.SetUseSkinFontInMenu(Value: Boolean);
begin
SkinMenu.UseSkinFont := Value;
end;
procedure TbsBusinessSkinForm.SetShowIcon(Value: Boolean);
begin
FShowIcon := Value;
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState)
then
SendMessage(FForm.Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsBusinessSkinForm.GetIcon;
var
IH: HICON;
IX, IY: Integer;
B: Boolean;
begin
if FIcon = nil
then
begin
FIcon := TIcon.Create;
B := False;
IH := 0;
if FForm.Icon.Handle <> 0
then
IH := FForm.Icon.Handle
else
if Application.Icon.Handle <> 0
then
IH := Application.Icon.Handle
else
begin
IH := LoadIcon(0, IDI_APPLICATION);
B := True;
end;
GetIconSize(IX, IY);
FIcon.Handle := CopyImage(IH, IMAGE_ICON, IX, IY, LR_COPYFROMRESOURCE);
if B then DestroyIcon(IH);
end;
end;
procedure TbsBusinessSkinForm.DrawFormIcon(Cnvs: TCanvas; X, Y: Integer);
begin
GetIcon;
if FIcon <> nil then
DrawIconEx(Cnvs.Handle, X, Y, FIcon.Handle, 0, 0, 0, 0, DI_NORMAL);
end;
procedure TbsBusinessSkinForm.GetIconSize(var X, Y: Integer);
begin
X := GetSystemMetrics(SM_CXSMICON);
if X = 0 then X := GetSystemMetrics(SM_CXSIZE);
Y := GetSystemMetrics(SM_CYSMICON);
if Y = 0 then Y := GetSystemMetrics(SM_CYSIZE);
end;
procedure TbsBusinessSkinForm.MDIItemClick(Sender: TObject);
var
I: Integer;
S1, S2: String;
MainBSF, ChildBSF: TbsBusinessSkinForm;
begin
MainBSF := GetBusinessSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
S1 := TMenuItem(Sender).Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
for I := 0 to MainBSF.FForm.MDIChildCount - 1 do
if MainBSF.FForm.MDIChildren[I].Name = S1
then
begin
ChildBSF := GetBusinessSkinFormComponent(MainBSF.FForm.MDIChildren[I]);
if (ChildBSF <> nil) and (ChildBSF.WindowState = wsMinimized)
then
ChildBSF.WindowState := wsNormal;
MainBSF.FForm.MDIChildren[I].Show;
end;
end;
procedure TbsBusinessSkinForm.UpDateChildCaptionInMenu(Child: TCustomForm);
var
WM: TMenuItem;
MainBSF: TbsBusinessSkinForm;
I: Integer;
S1, S2: String;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
S1 := WM.Items[I].Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
if Child.Name = S1
then
begin
WM.Items[I].Caption := Child.Caption;
Break;
end;
end;
end;
procedure TbsBusinessSkinForm.UpDateChildActiveInMenu;
var
WM: TMenuItem;
MainBSF: TbsBusinessSkinForm;
I: Integer;
S1, S2: String;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
S1 := WM.Items[I].Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
if MainBSF.FForm.ActiveMDIChild.Name = S1
then
WM.Items[I].Checked := True
else
WM.Items[I].Checked := False;
end;
end;
procedure TbsBusinessSkinForm.RefreshMDIBarTab(Child: TCustomForm);
var
MainBSF: TbsBusinessSkinForm;
I: Integer;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if (MainBSF = nil) or (MainBSF.MDITabsBar = nil) then Exit;
with MainBSF.MDITabsBar do
for I := 0 to ObjectList.Count - 1 do
if TbsMDITab(ObjectList.Items[I]).Child = Child
then
TbsMDITab(ObjectList.Items[I]).Draw(MainBSF.MDITabsBar.Canvas);
end;
procedure TbsBusinessSkinForm.AddChildToMenu;
var
WM: TMenuItem;
NewItem: TMenuItem;
MainBSF: TbsBusinessSkinForm;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
NewItem := TMenuItem.Create(Self);
NewItem.Name := Child.Name + MI_CHILDITEM;
NewItem.Caption := Child.Caption;
NewItem.OnClick := MDIItemClick;
WM.Add(NewItem);
end;
procedure TbsBusinessSkinForm.AddChildToBar;
var
MainBSF: TbsBusinessSkinForm;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if (MainBSF = nil) or (MainBSF.MDITabsBar = nil) then Exit;
MainBSF.MDITabsBar.AddTab(Child);
end;
procedure TbsBusinessSkinForm.DeleteChildFromMenu;
var
WM, MI: TMenuItem;
MainBSF: TbsBusinessSkinForm;
I: Integer;
S1, S2: String;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if MainBSF = nil then Exit;
WM := MainBSF.FForm.WindowMenu;
if WM = nil then Exit;
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
S1 := WM.Items[I].Name;
S2 := MI_CHILDITEM;
Delete(S1, Pos(S2, S1), Length(S2));
if Child.Name = S1
then
begin
MI := WM.Items[I];
WM.Delete(I);
MI.Free;
Break;
end;
end;
if MainBSF.FForm.MDIChildCount = 0
then
for I := 0 to WM.Count - 1 do
if (Pos(MI_CHILDITEM, WM.Items[I].Name) <> 0)
then
begin
MI := WM.Items[I];
WM.Delete(I);
MI.Free;
Break;
end;
end;
procedure TbsBusinessSkinForm.DeleteChildFromBar;
var
MainBSF: TbsBusinessSkinForm;
begin
MainBSF := BusinessSkinForm.GetBusinessSkinFormComponent(Application.MainForm);
if (MainBSF = nil) or (MainBSF.MDITabsBar = nil) then Exit;
MainBSF.MDITabsBar.DeleteTab(Child);
end;
procedure TbsBusinessSkinForm.SetAlphaBlend(Value: Boolean);
begin
if FAlphaBlend <> Value
then
begin
FAlphaBlend := Value;
if (ComponentState = []) and CheckW2KWXP
then
begin
if FAlphaBlend
then
begin
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetAlphaBlendTransparent(FForm.Handle, FAlphaBlendValue);
end
else
SetWindowLong(FForm.Handle, GWL_EXSTYLE,
GetWindowLong(FForm.Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;
end;
end;
procedure TbsBusinessSkinForm.SetAlphaBlendValue(Value: Byte);
begin
if FAlphaBlendValue <> Value
then
begin
FAlphaBlendValue := Value;
if FAlphaBlend and (ComponentState = []) and CheckW2KWXP
then
SetAlphaBlendTransparent(FForm.Handle, FAlphaBlendValue);
end;
end;
procedure TbsBusinessSkinForm.TrackSystemMenu(X, Y: Integer);
var
MenuItem: TMenuItem;
begin
MenuItem := GetSystemMenu;
SkinMenuOpen;
if MenusSkinData = nil
then
SkinMenu.Popup(nil, SkinData, 0, Rect(X, Y, X, Y), MenuItem, False)
else
SkinMenu.Popup(nil, MenusSkinData, 0, Rect(X, Y, X, Y), MenuItem, False);
end;
function TbsBusinessSkinForm.GetAutoRenderingInActiveImage: Boolean;
begin
if (FSD <> nil) and not (FSD.Empty)
then Result := FSD.AutoRenderingInActiveImage
else Result := False;
end;
procedure TbsBusinessSkinForm.UpDateActiveObjects;
var
i: Integer;
begin
if ObjectList <> nil
then
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinAnimateObject
then
begin
with TbsSkinAnimateObject(ObjectList.Items[i]) do
begin
FMouseIn := False;
Active := False;
FFrame := 1
end;
end
else
if not (TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinCaptionObject)
then
with TbsActiveSkinObject(ObjectList.Items[i]) do
begin
Active := False;
FMouseIn := False;
FMorphkf := 0;
end;
end;
procedure TbsBusinessSkinForm.TestAnimate;
var
i: Integer;
StopAnimate: Boolean;
begin
StopAnimate := True;
for i := 0 to ObjectList.Count - 1 do
if TbsActiveSkinObject(ObjectList.Items[i]) is TbsSkinAnimateObject
then
with TbsSkinAnimateObject(ObjectList.Items[i]) do
if Active
then
begin
ChangeFrame;
StopAnimate := False;
end;
if StopAnimate
then AnimateTimer.Enabled := False;
end;
procedure TbsBusinessSkinForm.TestMorph;
var
i: Integer;
StopMorph: Boolean;
begin
StopMorph := True;
for i := 0 to ObjectList.Count - 1 do
with TbsActiveSkinObject(ObjectList.Items[i]) do
begin
if Morphing and CanMorphing
then
begin
DoMorphing;
StopMorph := False;
end;
end;
if StopMorph then MorphTimer.Enabled := False;
end;
procedure TbsBusinessSkinForm.SetMenusAlphaBlend(Value: Boolean);
begin
FMenusAlphaBlend := Value;
if SkinMenu <> nil then SkinMenu.AlphaBlend := Value;
end;
procedure TbsBusinessSkinForm.SetMenusAlphaBlendAnimation(Value: Boolean);
begin
FMenusAlphaBlendAnimation := Value;
if SkinMenu <> nil then SkinMenu.AlphaBlendAnimation := Value;
end;
procedure TbsBusinessSkinForm.SetMenusAlphaBlendValue(Value: Byte);
begin
FMenusAlphaBlendValue := Value;
if SkinMenu <> nil then SkinMenu.AlphaBlendValue := Value;
end;
function TbsBusinessSkinForm.IsSizeAble;
begin
Result := (FForm.BorderStyle = bsSizeAble) or
(FForm.BorderStyle = bsSizeToolWin);
end;
function TbsBusinessSkinForm.GetDefCaptionHeight: Integer;
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
begin
with TbsSkinStdButtonObject(ObjectList.Items[I]) do
if Visible and SkinRectInAPicture and (Command = C)
then
begin
Result := TbsSkinStdButtonObject(ObjectList.Items[I]);
Break;
end;
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);
Button := GetStdButton(cmMinimizeToTray);
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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
begin
CB.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet;
Font.Charset := SkinData.ResourceStrData.CharSet;
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);
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
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);
if not FLogoBitMap.Empty then DrawLogoBitMap(C);
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, FW1, FH1, W, H, Offset1, Offset2: Integer;
R: TRect;
begin
if FForm.FormStyle <> fsMDIForm then Exit;
RestoreAll;
R := GetMDIWorkArea;
W := RectWidth(R);
H := RectHeight(R);
if FSkinSupport
then
Offset1 := NewClRect.Top
else
Offset1 := GetDefCaptionHeight + 3;
Offset2 := W - Round(W * 0.8);
j := Offset2 div Offset1;
if FForm.MDIChildCount < j
then
begin
FW := W - (FForm.MDIChildCount - 1) * Offset1;
FH := H - (FForm.MDIChildCount - 1) * Offset1;
end
else
begin
FW := W - j * Offset1;
FH := H - j * Offset1;
end;
if FW < GetMinWidth then FW := GetMinWidth;
if FH < GetMinHeight then FH := GetMinHeight;
k := 0;
for i := FForm.MDIChildCount - 1 downto 0 do
begin
FW1 := FW;
FH1 := FH;
if (FForm.MDIChildren[i].BorderStyle = bsSingle)
then
begin
FW1 := FForm.MDIChildren[i].Width;
FH1 := FForm.MDIChildren[i].Height;
end;
if (k + FW1 > W) or (k + FH1 > H) then k := 0;
FForm.MDIChildren[i].SetBounds(k, k, FW1, FH1);
k := k + Offset1;
end;
end;
procedure 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;
if not FAlwaysShowInTray then 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
if not FAlwaysShowInTray then IconVisible := False;
MinimizeToTray := False;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
Self.BorderIcons := Self.BorderIcons + [biMinimizeToTray];
if not (csDesigning in ComponentState)
then
begin
if PopupMenu = nil
then
begin
PopupMenu := FSysTrayMenu;
OnDblClick := TrayIconDBLCLK;
end;
end;
end
else
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
Self.BorderIcons := Self.BorderIcons - [biMinimizeToTray];
end;
procedure 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
if FAlwaysMinimizeToTray
then
MinimizeToTray
else
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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_MAXCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_MINCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_RESTORECAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_ROLLUPCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_CLOSECAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_MINTOTRAYCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_RESTORECAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_CLOSECAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_MAXCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_MINCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_RESTORECAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_ROLLUPCAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_CLOSECAPTION')
else
Caption := BS_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;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('MI_MINTOTRAYCAPTION')
else
Caption := BS_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
R := GetMonitorWorkArea(FForm.Handle, True);
P.Y := R.Bottom - MH;
P.X := R.Left;
repeat
B := GetSDIEqualCoord(P);
if not B
then
begin
P.X := P.X + MW;
if P.X + MW > R.Bottom
then
begin
P.X := R.Left;
P.Y := P.Y - MH;
if P.Y < R.Top
then
begin
P.Y := R.Bottom - MH;
B := True;
end;
end;
end;
until B;
end;
Result := P;
end;
function 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
R := GetMonitorWorkArea(FForm.Handle, not FMaximizeOnFullScreen);
Result := RectWidth(R);
end;
function TbsBusinessSkinForm.GetMaxHeight: Integer;
var
R: TRect;
begin
R := GetMonitorWorkArea(FForm.Handle, not FMaximizeOnFullScreen);
Result := RectHeight(R);
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;
// create 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,
LeftStretch, TopStretch, RightStretch, BottomStretch);
// 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;