businessskinform.pas

BusinessSkinForm Ver3.95 full source_汉化版_最新

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;
  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
  FInc := AnimateTimerInterval;
  FFrame := 1;
  Active := True;
  if not Parent.AnimateTimer.Enabled
  then
    Parent.AnimateTimer.Enabled := True;
end;

procedure TbsSkinAnimateObject.Stop;
begin
  Frame := 1;
  Active := False;
  FInc := AnimateTimerInterval;
end;

procedure TbsSkinAnimateObject.ChangeFrame;
begin
  if FInc >= TimerInterval
  then
    begin
      if Increment
      then
        begin
          Frame := Frame + 1;
          if not Cycle and (FFrame = CountFrames) then Active := False;
        end
      else
        begin
          Frame := Frame - 1;
          if FFrame = 1 then Active := False;
        end;
      FInc := AnimateTimerInterval;
    end
  else
    Inc(FInc, AnimateTimerInterval);
end;

procedure TbsSkinAnimateObject.MouseEnter;
begin
  FMouseIn := True;
  if FMenuTracking then Exit;
  if ButtonStyle
  then
    begin
      Active := True;
      Increment := True;
      if (FDown and FMouseIn) and not IsNullRect(DownSkinRect)
      then
        begin
          Parent.DrawSkinObject(Self);
        end
      else  
      if not Parent.AnimateTimer.Enabled
      then
        Parent.AnimateTimer.Enabled := True;
    end;
  Parent.MouseEnterEvent(IDName);
end;

procedure TbsSkinAnimateObject.MouseLeave;
begin
  if not FMouseIn then Exit;
  FMouseIn := False;
  if FMenuTracking then Exit;
  if ButtonStyle
  then
    begin
      Active := True;
      Increment := False;
      if FDown and not IsNullRect(DownSkinRect)
      then
        begin
          Parent.DrawSkinObject(Self);
        end
      else
      if not Parent.AnimateTimer.Enabled
      then
        Parent.AnimateTimer.Enabled := True;
    end;
  Parent.MouseLeaveEvent(IDName);
end;

procedure TbsSkinAnimateObject.Draw;
var
  FW, FH: Integer;
begin
  FW := RectWidth(SkinRect);
  FH := RectHeight(SkinRect);
  if FMenuTracking
  then
    begin
      if not IsNullRect(DownSkinRect)
      then
        Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownSkinRect)
      else
        begin
          FFrame := Self.CountFrames;
          Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas,
           Rect(ActiveSkinRect.Left + (FFrame - 1) * FW, ActiveSkinRect.Top,
                ActiveSkinRect.Left + FFrame * FW,
                ActiveSkinRect.Top + FH));
        end;
    end
  else
  if not Parent.GetFormActive and not IsNullRect(InActiveSkinRect)
  then
    begin
      Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, InActiveSkinRect);
    end
  else
  if (FDown and FMouseIn) and not IsNullRect(DownSkinRect)
  then
    begin
      Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownSkinRect);
    end
  else
  Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas,
           Rect(ActiveSkinRect.Left + (FFrame - 1) * FW, ActiveSkinRect.Top,
                ActiveSkinRect.Left + FFrame * FW,
                ActiveSkinRect.Top + FH));
end;


//============= TbsSkinButtonObject ============= //
constructor TbsSkinButtonObject.Create;
begin
  inherited Create(AParent, AData);
  if AData <> nil
  then 
  with TbsDataSkinButton(AData) do
  begin
    Self.DownRect := DownRect;
    Self.DisableSkinRect := DisableSkinRect;
  end;
  MenuItem := nil;
  FPopupUp := False;
end;

function TbsSkinButtonObject.CanMorphing;
begin
  Result := inherited CanMorphing;
  Result := Result and not ((MenuItem <> nil) and FDown);
end;

procedure TbsSkinButtonObject.Draw;
begin
  if not Enabled and not IsNullRect(DisableSkinRect)
  then
    Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DisableSkinRect)
  else
  if FDown and not IsNullRect(DownRect) and FMouseIn
  then
    Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownRect)
  else
    inherited Draw(Cnvs, UpDate);
end;

procedure TbsSkinButtonObject.SetDown;
begin
  FDown := Value;
  if EnableMorphing and Active then MorphKf := 1;
  Parent.DrawSkinObject(Self);
  if EnableMorphing and not FDown then ReDraw;
end;

procedure TbsSkinButtonObject.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);
  Menu := MenuItem.GetParentMenu;
  if Menu is TbsSkinPopupMenu
  then
    TbsSkinPopupMenu(Menu).PopupFromRect(R, FPopupUp)
  else
    begin
      Parent.SkinMenuOpen;
      if Menu is TbsSkinMainMenu
      then
        Parent.SkinMenu.Popup(nil, TbsSkinMainMenu(Menu).SkinData, 0, R, MenuItem, FPopupUp)
      else
        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 TbsSkinButtonObject.MouseDown;
begin
  if not Enabled then Exit;
  if (Button = mbLeft) and not FDown
  then
    begin
      SetDown(True);
      TrackMenu;
    end;
  inherited MouseDown(X, Y, Button);
end;

procedure TbsSkinButtonObject.MouseUp;
begin
  if not Enabled then Exit;
  if (Button <> mbLeft)
  then
    begin
      inherited MouseUp(X, Y, Button);
      Exit;
    end;
  if (MenuItem = nil) and FDown
  then
    SetDown(False);
  inherited MouseUp(X, Y, Button);
end;

procedure TbsSkinButtonObject.MouseEnter;
begin
  FMouseIn := True;
  Active := True;
  if IsNullRect(DownRect) or not FDown
  then
    begin
      if not IsNullRect(ActiveSkinRect) then ReDraw;
    end
  else                   
    begin
      if FDown
      then
        begin
          if EnableMorphing then FMorphKf := 1;