businessskinform.pas

Delphi开发的图象处理软件

      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.MouseUp;
begin
  inherited;
  if 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 ButtonStyle
  then
    begin
      Active := True;
      Increment := True;
      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 ButtonStyle
  then
    begin
      Active := True;
      Increment := False;
      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);
  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 Morphing and Active then MorphKf := 1;
  Parent.DrawSkinObject(Self);
  if Morphing 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 Morphing then FMorphKf := 1;
          Parent.DrawSkinObject(Self)
        end
      else
        if not IsNullRect(ActiveSkinRect) then ReDraw;
    end;
  Parent.MouseEnterEvent(IDName);
end;

procedure TbsSkinButtonObject.MouseLeave;
begin
  FMouseIn := False;
  Active := False;
  if (MenuItem = nil) or ((MenuItem <> nil) and not FDown)
  then
    begin
      Parent.DrawSkinObject(Self);
      Redraw;
    end;
  Parent.MouseLeaveEvent(IDName);
end;

//============= TbsSkinStdButtonObject =================//

constructor TbsSkinStdButtonObject.Create;
begin
  inherited Create(AParent, AData);
  if AData <> nil
  then
    with TbsDataSkinStdButton(AData) do
    begin
      Self.Command := Command;
      Self.RestoreRect := RestoreRect;
      Self.RestoreActiveRect := RestoreActiveRect;
      Self.RestoreInActiveRect := RestoreInActiveRect;
      Self.RestoreDownRect := RestoreDownRect;
      FSkinSupport := True;
    end
  else
    FSkinSupport := False;
end;

function TbsSkinStdButtonObject.CanMorphing: Boolean;
begin
  if (Command = cmSysMenu) and Parent.ShowIcon and
     (SkinRectInAPicture)
  then
    Result := False
  else
    Result := inherited CanMorphing;
end;

procedure TbsSkinStdButtonObject.DefaultDraw(Cnvs: TCanvas);
var
  Buffer: TBitMap;
  R: TRect;
  IX, IY: Integer;
  IC: TColor;
begin
  if (Command = cmSysMenu) and Parent.FShowIcon
  then
    begin
      Parent.DrawFormIcon(Cnvs, ObjectRect.Left, ObjectRect.Top);
      Exit;
    end;
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(ObjectRect);
  Buffer.Height := RectHeight(ObjectRect);
  R := Rect(0, 0, Buffer.Width, Buffer.Height);
  with Buffer.Canvas do
  begin
    if FDown and FMouseIn
    then
      begin
        Frame3D(Buffer.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
        Brush.Color := BS_XP_BTNDOWNCOLOR;
        FillRect(R);
      end
    else
      if FMouseIn
      then
        begin
          Frame3D(Buffer.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
          Brush.Color := BS_XP_BTNACTIVECOLOR;
          FillRect(R);
        end
      else

        begin
          Brush.Color := clBtnFace;
          FillRect(R);
        end;
  end;
  IX := Buffer.Width div 2 - 5;
  IY := Buffer.Height div 2 - 4;
  if FDown and FMouseIn
  then
    begin
      Inc(IX);
      Inc(IY);
    end;
  if Enabled
  then
    IC := clBtnText
  else
    IC := clBtnShadow;
  case Command of
    cmMinimizeToTray:
      DrawMTImage(Buffer.Canvas, IX, IY, IC);
    cmClose:
      DrawCloseImage(Buffer.Canvas, IX, IY, IC);
    cmMaximize:
      if Parent.WindowState = wsMaximized
      then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
      else DrawMaximizeImage(Buffer.Canvas, IX, IY, IC);
    cmMinimize:
      if Parent.WindowState = wsMinimized
      then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
      else DrawMinimizeImage(Buffer.Canvas, IX, IY, IC);
    cmRollUp:
      if Parent.RollUpState
      then DrawRestoreRollUpImage(Buffer.Canvas, IX, IY, IC)
      else DrawRollUpImage(Buffer.Canvas, IX, IY, IC);
    cmSysMenu:
      DrawSysMenuImage(Buffer.Canvas, IX, IY, IC);
  end;
  Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
  Buffer.Free;
end;

procedure TbsSkinStdButtonObject.Draw;

procedure CreateRestoreObjectImage(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, RestoreActiveRect)
    else
      CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, RestoreRect);
  end;
end;

var
  PBuffer, APBuffer: TbsEffectBmp;
  Buffer, ABuffer: TBitMap;
  ASR, SR: TRect;
  FRestoreMode: Boolean;
begin
  if not FSkinSupport
  then
    begin
      DefaultDraw(Cnvs);
      Exit;
    end;

  if not Enabled
  then
    begin
      inherited;
      Exit;
    end;

  if (Command = cmSysMenu) and Parent.FShowIcon and SkinRectInAPicture
  then
    begin
      Parent.DrawFormIcon(Cnvs, ObjectRect.Left, ObjectRect.Top);
      FMorphKf := 0;
      Exit;
    end;

    
  FRestoreMode := False;
  case Command of
    cmMaximize:
      if Parent.WindowState = wsMaximized
      then FRestoreMode := True;
    cmMinimize:
      if Parent.WindowState = wsMinimized
      then FRestoreMode := True;
    cmRollUp:
      if Parent.RollUpState
      then FRestoreMode := True;
  end;