⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dynamicskinform.pas

📁 P2P即时通讯源码(DELPHI编写)
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  else
    if MouseDownChangeValue and (Button = mbLeft)
    then
      case TrackKind of
        tkHorizontal:
          begin
            if X1 < BeginPoint.X then X1 := BeginPoint.X;
            if X1 > EndPoint.X then X1 := EndPoint.X;
            ButtonPos := Point(X1, BeginPoint.Y);
          end;
        tkVertical:
          begin
            if Y1 < EndPoint.Y then Y1 := EndPoint.Y;
            if Y1 > BeginPoint.Y then Y1 := BeginPoint.Y;
            ButtonPos := Point(BeginPoint.X, Y1);
          end;
     end;
  inherited MouseDown(X, Y, Button);
end;

procedure TspSkinTrackBarObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
  if MoveActive and (Button = mbLeft)
  then
    begin
      MoveActive := False;
      if not IsNullRect(ActiveButtonRect)
      then
        Parent.DrawSkinObject(Self);
    end;
  inherited MouseUp(X, Y, Button);
end;

procedure TspSkinTrackBarObject.MouseMove(X, Y: Integer);
var
  X1, Y1: Integer;
  TestPos: Integer;
begin
  X1 := X - ObjectRect.Left;
  Y1 := Y - ObjectRect.Top;
  if MoveActive
  then
    case TrackKind of
      tkHorizontal:
        begin
          TestPos := FButtonPos.X + X1 - FOldMPoint.X;
          if (TestPos >= BeginPoint.X) and (TestPos <= EndPoint.X)
          then
            ButtonPos := Point(TestPos, FButtonPos.Y);
        end;

        tkVertical:
          begin
            TestPos := FButtonPos.Y + Y1 - FOldMPoint.Y;
            if (TestPos >= EndPoint.Y) and (TestPos <= BeginPoint.Y)
            then ButtonPos := Point(FButtonPos.X, TestPos);
          end;
    end;
  FOldMPoint := Point(X1, Y1);
  inherited MouseMove(X, Y);
end;

//============= TspSkinSwitchObject ==============//
constructor TspSkinSwitchObject.Create;
begin
  inherited Create(AParent, AData);
  FState := swsOff;
end;

procedure TspSkinSwitchObject.SetState;
begin
  FState := Value;
  if FState = swsOn then Active := True else Active := False;
  ReDraw;
  Parent.SwitchChangeStateEvent(IDName, FState);
end;

procedure TspSkinSwitchObject.SimpleSetState(Value: TSwitchState);
begin
  FState := Value;
  Active := FState = swsOn;
  if Active then FMorphKf := 1;
end;

procedure TspSkinSwitchObject.MouseDown;
begin
  if Button = mbLeft
  then
    if State = swsOff then State := swsOn else State := swsOff;
  inherited MouseDown(X, Y, Button);
end;

procedure TspSkinSwitchObject.MouseEnter;
begin
  FMouseIn := True;
  Parent.MouseEnterEvent(IDName);
end;

procedure TspSkinSwitchObject.MouseLeave;
begin
  FMouseIn := False;
  Parent.MouseLeaveEvent(IDName);
end;

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

procedure TspSkinButtonObject.Draw;
begin
  if not Enabled and not IsNullRect(DisableSkinRect)
  then
    Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DisableSkinRect)
  else
  if (FDown and not IsNullRect(DownRect)) and
     ((GroupIndex <> -1) or FMouseIn)
  then
    Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, DownRect)
  else
    inherited Draw(Cnvs, UpDate);
end;

procedure TspSkinButtonObject.SetDown;

procedure DoAllUp;
var
  i, j: Integer;
begin
  j := GroupIndex;
  if j <> -1 then
  for i := 0 to Parent.ObjectList.Count - 1 do
    if (TspActiveSkinObject(Parent.ObjectList.Items[i]) is TspSkinButtonObject) and
       (TspActiveSkinObject(Parent.ObjectList.Items[i]).IDName <> IDName)
    then
      with TspSkinButtonObject(Parent.ObjectList.Items[i]) do
        if (j = GroupIndex) and FDown
        then
          begin
            SetDown(False);
            Break;
          end;
end;

begin
  FDown := Value;
  if IsNullRect(DownRect) and not FDown then Exit;
  if IsNullRect(DownRect) and FDown
  then
    begin
      DoAllUp;
      Exit;
    end
  else
    if FDown
    then
      begin
        if Morphing then MorphKf := 1;
        Parent.DrawSkinObject(Self);
        DoAllUp;
      end
    else
      begin
        if (GroupIndex <> -1) or (MenuItem <> nil) then Active := False;
        if Morphing and not IsNullRect(DownRect)
        then
          Parent.DrawSkinObject(Self);
        ReDraw;
      end;
end;

procedure TspSkinButtonObject.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 TspSkinPopupMenu
  then
    TspSkinPopupMenu(Menu).PopupFromRect(R, FPopupUp)
  else
    begin
      Parent.SkinMenuOpen;
      if Menu is TspSkinMainMenu
      then
        Parent.SkinMenu.Popup(nil, TspSkinMainMenu(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 TspSkinButtonObject.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 TspSkinButtonObject.MouseUp;
begin
  if not Enabled then Exit;
  if (Button <> mbLeft)
  then
    begin
      inherited MouseUp(X, Y, Button);
      Exit;
    end;
  if (MenuItem = nil) and FDown and (GroupIndex = -1)
  then
    SetDown(False);
  inherited MouseUp(X, Y, Button);
end;

procedure TspSkinButtonObject.MouseEnter;
begin
  FMouseIn := True;
  Active := True;
  if IsNullRect(DownRect) or not FDown
  then
    begin
      if not IsNullRect(ActiveSkinRect) then ReDraw;
    end
  else
    if not (FDown and (GroupIndex <> -1))
    then
      begin
        if FDown
        then
          Parent.DrawSkinObject(Self)
        else
          if not IsNullRect(ActiveSkinRect) and (GroupIndex = -1) then ReDraw;
    end;
  Parent.MouseEnterEvent(IDName);
end;

procedure TspSkinButtonObject.MouseLeave;
begin
  FMouseIn := False;
  if not (FDown and not IsNullRect(DownRect) and
         ((MenuItem <> nil) or (GroupIndex <> -1)))
  then
    begin
      Active := False;
      if Morphing and FDown then Morphkf := 1;
      if (not IsNullRect(ActiveSkinRect)) or
         (not IsNullRect(DownRect) and (GroupIndex = -1)) then Redraw;
    end;
  Parent.MouseLeaveEvent(IDName);
end;

//============= TspSkinStdButtonObject =================//

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

procedure TspSkinStdButtonObject.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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
        Brush.Color := SP_XP_BTNDOWNCOLOR;
        FillRect(R);
      end
    else
      if FMouseIn
      then
        begin
          Frame3D(Buffer.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
          Brush.Color := SP_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
    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;

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

proc

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -