businessskinform.pas

一套非常优秀的皮肤组件包

  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;
          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;

  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;

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

  if (not Enabled) or
     (Enabled and (not Parent.GetFormActive) and (not IsNullRect(InActiveSkinRect)) and not FRestoreMode)
  then
    begin
      inherited;
      Exit;
    end;

  if IsNullRect(RestoreRect) or not FRestoreMode
  then
    inherited
  else
    begin
      if not Parent.FFormActive and not IsNullRect(RestoreInActiveRect)
      then
        Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, RestoreInActiveRect)
      else
      if FDown and not IsNullRect(RestoreDownRect) and FMouseIn
      then
        Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, RestoreDownRect)
      else
        begin
          ASR := RestoreActiveRect;
          SR := RestoreRect;
          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
                Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, SR);
            end
          else
            begin
              Buffer := TBitMap.Create;
              ABuffer := TBitMap.Create;
              CreateRestoreObjectImage(Buffer, False);
              CreateRestoreObjectImage(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;
    end;
end;

procedure TbsSkinStdButtonObject.DoMinimizeToTray;
begin
  Parent.MinimizeToTray;
end;

procedure TbsSkinStdButtonObject.DoMax;
begin
  if Parent.WindowState = wsMaximized
  then Parent.WindowState := wsNormal
  else Parent.WindowState := wsMaximized;
end;

procedure TbsSkinStdButtonObject.DoMin;
begin
  if Parent.WindowState = wsMinimized
  then Parent.WindowState := wsNormal
  else Parent.WindowState := wsMinimized;
end;

procedure TbsSkinStdButtonObject.DoClose;
begin
  Parent.FForm.Close;
end;

procedure TbsSkinStdButtonObject.DoRollUp;
begin
  Parent.RollUpState := not Parent.RollUpState;
end;

procedure TbsSkinStdButtonObject.DoCommand;
begin
  case Command of
    cmMinimizeToTray: DoMinimizeToTray;
    cmClose: DoClose;
    cmMinimize:
      if Parent.AlwaysMinimizeToTray
      then
        Parent.MinimizeToTray
      else
        DoMin;
    cmMaximize: DoMax;
    cmRollUp: DoRollUp;
  end;
end;

procedure TbsSkinStdButtonObject.DblClick;
begin
  if Command = cmSysMenu then DoClose;
end;

procedure TbsSkinStdButtonObject.MouseDown;
begin
  if not Enabled then Exit;
  if (Button = mbLeft) and not FDown
  then
    begin
      SetDown(True);
      if (Command = cmSysMenu)
      then
        begin
          Self.MenuItem := Parent.GetSystemMenu;
          TrackMenu;
        end;
    end;
end;

procedure TbsSkinStdButtonObject.MouseUp;
begin
  if (Command = cmClo