?? businessskinform.pas
字號:
end;
end;
function GetMDIChildBusinessSkinFormComponent2;
begin
if (Application.MainForm <> nil) and (Application.MainForm.ActiveMDIChild <> nil)
then
Result := GetBusinessSkinFormComponent(Application.MainForm.ActiveMDIChild)
else
Result := nil;
end;
//============= TbsSkinComponent ============= //
constructor TbsSkinComponent.Create(AOwner: TComponent);
begin
inherited;
FSkinData := nil;
end;
procedure TbsSkinComponent.SetSkinData(Value: TbsSkinData);
begin
FSkinData := Value;
end;
procedure TbsSkinComponent.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSkinData) then FSkinData := nil;
end;
procedure TbsSkinComponent.BeforeChangeSkinData;
begin
end;
procedure TbsSkinComponent.ChangeSkinData;
begin
end;
//============= TbsActiveSkinObject ============= //
constructor TbsActiveSkinObject.Create;
begin
Visible := True;
Enabled := True;
Parent := AParent;
SD := Parent.SkinData;
FMorphKf := 0;
Morphing := False;
if AData <> nil
then
begin
with AData do
begin
Self.IDName := IDName;
Self.Hint := Hint;
Self.SkinRectInAPicture := SkinRectInAPicture;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
Self.InActiveSkinRect:= InActiveSkinRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
if (ActivePictureIndex <> - 1) and
(ActivePictureIndex < SD.FActivePictures.Count)
then
ActivePicture := TBitMap(SD.FActivePictures.Items[ActivePictureIndex])
else
begin
ActivePicture := nil;
ActiveSkinRect := NullRect;
end;
end;
if Morphing and IsNullRect(ActiveSkinRect) then Morphing := False;
ObjectRect := SkinRect;
Picture := SD.FPicture;
end;
end;
function TbsActiveSkinObject.EnableMorphing: Boolean;
begin
Result := Morphing and (Parent.SkinData <> nil) and
not (Parent.SkinData.Empty) and
Parent.SkinData.EnableSkinEffects;
end;
procedure TbsActiveSkinObject.ReDraw;
begin
if EnableMorphing
then Parent.MorphTimer.Enabled := True
else Parent.DrawSkinObject(Self);
end;
procedure TbsActiveSkinObject.DblClick;
begin
end;
procedure TbsActiveSkinObject.MouseDown(X, Y: Integer; Button: TMouseButton);
begin
Parent.MouseDownEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TbsActiveSkinObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
if FMouseIn then Parent.MouseUpEvent(IDName, X, Y, ObjectRect, Button);
end;
procedure TbsActiveSkinObject.MouseMove(X, Y: Integer);
begin
Parent.MouseMoveEvent(IDName, X, Y, ObjectRect);
end;
procedure TbsActiveSkinObject.MouseEnter;
begin
FMouseIn := True;
Active := True;
if not IsNullRect(ActiveSkinRect) then ReDraw;
Parent.MouseEnterEvent(IDName);
end;
procedure TbsActiveSkinObject.MouseLeave;
begin
FMouseIn := False;
Active := False;
if not IsNullRect(ActiveSkinRect) then ReDraw;
Parent.MouseLeaveEvent(IDName);
end;
function TbsActiveSkinObject.CanMorphing;
begin
Result := (Active and (MorphKf < 1)) or
(not Active and (MorphKf > 0));
end;
procedure TbsActiveSkinObject.DoMorphing;
begin
if Active
then MorphKf := MorphKf + MorphInc
else MorphKf := MorphKf - MorphInc;
Parent.DrawSkinObject(Self);
end;
procedure TbsActiveSkinObject.Draw;
procedure CreateObjectImage(B: TBitMap; AActive: Boolean);
begin
B.Width := RectWidth(ObjectRect);
B.Height := RectHeight(ObjectRect);
with B.Canvas do
begin
if AActive
then
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, ActiveSkinRect)
else
if SkinRectInApicture
then
CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, SkinRect)
else
CopyRect(Rect(0, 0, B.Width, B.Height), Picture.Canvas, SkinRect);
end;
end;
var
PBuffer, APBuffer: TbsEffectBmp;
Buffer, ABuffer: TBitMap;
ASR, SR: TRect;
begin
ASR := ActiveSkinRect;
SR := SkinRect;
if (Parent.SkinData = nil) or ((Parent.SkinData <> nil) and (Parent.SkinData.Empty))
then
Exit;
if Enabled and (not Parent.GetFormActive) and (not IsNullRect(InActiveSkinRect))
then
begin
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, InActiveSkinRect)
end
else
if not EnableMorphing or
((Active and (MorphKf = 1)) or (not Active and (MorphKf = 0)))
then
begin
if Active and not IsNullRect(ASR)
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, ASR)
else
if UpDate or SkinRectInApicture
then
begin
if SkinRectInApicture
then
Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, SR)
else
Cnvs.CopyRect(ObjectRect, Picture.Canvas, SR);
end;
end
else
begin
Buffer := TBitMap.Create;
ABuffer := TBitMap.Create;
CreateObjectImage(Buffer, False);
CreateObjectImage(ABuffer, True);
PBuffer := TbsEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TbsEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, MorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
mkPush: PBuffer.MorphPush(APBuffer, MorphKf);
end;
PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
PBuffer.Free;
APBuffer.Free;
Buffer.Free;
ABuffer.Free;
end;
end;
procedure TbsActiveSkinObject.SetMorphKf(Value: Double);
begin
FMorphKf := Value;
if FMorphKf < 0 then FMorphKf := 0 else
if FMorphKf > 1 then FMorphKf := 1;
end;
procedure TbsUserObject.Draw;
begin
Parent.PaintEvent(IDName, Cnvs, ObjectRect);
end;
//==============TbsSkinAnimateObject==================//
constructor TbsSkinAnimateObject.Create;
begin
inherited Create(AParent, AData);
FMenuTracking := False;
FDown := False;
Increment := True;
FFrame := 1;
FInc := AnimateTimerInterval;
TimerInterval := TbsDataSkinAnimate(AData).TimerInterval;
if TimerInterval < FInc then TimerInterval := FInc;
with TbsDataSkinAnimate(AData) do
begin
Self.CountFrames := CountFrames;
Self.Cycle := Cycle;
Self.ButtonStyle := ButtonStyle;
Self.Command := Command;
Self.DownSkinRect := DownSkinRect;
Self.RestoreRect := RestoreRect;
Self.RestoreActiveRect := RestoreActiveRect;
Self.RestoreInActiveRect := RestoreInActiveRect;
Self.RestoreDownRect := RestoreDownRect;
end;
FPopupUp := False;
MenuItem := nil;
end;
procedure TbsSkinAnimateObject.DoMinToTray;
begin
Parent.MinimizeToTray;
end;
procedure TbsSkinAnimateObject.DoMax;
begin
if Parent.WindowState = wsMaximized
then Parent.WindowState := wsNormal
else Parent.WindowState := wsMaximized;
end;
procedure TbsSkinAnimateObject.DoMin;
begin
if Parent.WindowState = wsMinimized
then Parent.WindowState := wsNormal
else Parent.WindowState := wsMinimized;
end;
procedure TbsSkinAnimateObject.DoClose;
begin
Parent.FForm.Close;
end;
procedure TbsSkinAnimateObject.DoRollUp;
begin
Parent.RollUpState := not Parent.RollUpState;
end;
procedure TbsSkinAnimateObject.DoCommand;
begin
case Command of
cmMinimizeToTray: DoMinToTray;
cmClose: DoClose;
cmMinimize:
begin
if not Parent.AlwaysMinimizeToTray
then
DoMin
else
Parent.MinimizeToTray;
end;
cmMaximize: DoMax;
cmSysMenu:
begin
MenuItem := Parent.GetSystemMenu;
TrackMenu;
end;
cmDefault:
if MenuItem <> nil then TrackMenu;
cmRollUp: DoRollUp;
end;
end;
procedure TbsSkinAnimateObject.TrackMenu;
var
R: TRect;
Menu: TMenu;
P: TPoint;
begin
if MenuItem = nil then Exit;
if MenuItem.Count = 0 then Exit;
R := ObjectRect;
if Parent.FForm.FormStyle = fsMDIChild
then
begin
if Parent.FSkinSupport
then
P := Point(-Parent.NewClRect.Left, -Parent.NewClRect.Top)
else
P := Point(- 3, -Parent.GetDefCaptionHeight - 3);
P := Parent.FForm.ClientToScreen(P);
OffsetRect(R, P.X, P.Y);
end
else
OffsetRect(R, Parent.FForm.Left, Parent.FForm.Top);
FMenuTracking := True;
Menu := MenuItem.GetParentMenu;
if Menu is TbsSkinPopupMenu
then
TbsSkinPopupMenu(Menu).PopupFromRect(R, FPopupUp)
else
begin
Parent.SkinMenuOpen;
if Parent.MenusSkinData = nil
then
Parent.SkinMenu.Popup(nil, Parent.SkinData, 0, R, MenuItem, FPopupUp)
else
Parent.SkinMenu.Popup(nil, Parent.MenusSkinData, 0, R, MenuItem, FPopupUp);
end;
end;
procedure TbsSkinAnimateObject.DblCLick;
begin
if Command = cmSysMenu then DoClose;
end;
procedure TbsSkinAnimateObject.MouseDown(X, Y: Integer; Button: TMouseButton);
begin
inherited;
if not IsNullRect(DownSkinRect) and (Button = mbLeft)
then
begin
FFrame := CountFrames;
FDown := True;
Parent.DrawSkinObject(Self);
end;
if (Command = cmsysmenu) and FMouseIn and ButtonStyle and (Button = mbLeft)
then DoCommand;
end;
procedure TbsSkinAnimateObject.MouseUp;
begin
inherited;
if FMenuTracking then Exit;
if not IsNullRect(DownSkinRect) and (Button = mbLeft)
then
begin
FDown := False;
Parent.DrawSkinObject(Self);
if not Parent.AnimateTimer.Enabled
then
Parent.AnimateTimer.Enabled := True;
end;
if (Command <> cmsysmenu) and FMouseIn and ButtonStyle and (Button = mbLeft)
then DoCommand;
end;
procedure TbsSkinAnimateObject.SetFrame;
begin
if Increment
then
begin
if Value > CountFrames then FFrame := 1 else FFrame := Value;
end
else
begin
if Value < 1 then FFrame := CountFrames else FFrame := Value;
end;
Parent.DrawSkinObject(Self);
end;
procedure TbsSkinAnimateObject.Start;
begin
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -