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

📄 sskinprovider.pas

📁 AlphaControls是一个Delphi标准控件的集合
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  end;
end;

function TsSkinProvider.ButtonWidth: integer;
begin
  if IsValidImgIndex(ButtonClose.ImageIndex) then begin
     Result := ma[ButtonClose.ImageIndex].Bmp.Width div 3;
  end
  else Result := 21;
end;

function TsSkinProvider.CaptionHeight: integer;
var
  R : TRect;
begin
  Result := 0;
  if Form.BorderStyle = bsNone then Exit;

  GetWindowRect(Form.Handle, R);

  case Form.BorderStyle of
    bsToolWindow, bsSingle, bsDialog: InflateRect(R, -GetSystemMetrics(SM_CXFIXEDFRAME), -GetSystemMetrics(SM_CYFIXEDFRAME));
    bsSizeable, bsSizeToolWin:        InflateRect(R, -GetSystemMetrics(SM_CXSIZEFRAME),  -GetSystemMetrics(SM_CYSIZEFRAME));
  end;
  if Form.BorderStyle in [bsToolWindow, bsSizeToolWin] then begin
    R.Bottom := R.Top + GetSystemMetrics(SM_CYSMCAPTION) - 1 * integer(Form.BorderStyle = bsToolWindow)
  end
  else begin
    R.Bottom := R.Top + GetSystemMetrics(SM_CYCAPTION) - 6 * integer(Form.BorderStyle = bsSizeToolWin);
  end;
  Result := HeightOf(R);//GetSystemMetrics(SM_CYCAPTION)// * integer(Form.BorderStyle = bsNone);
end;

constructor TsSkinProvider.Create(AOwner: TCOmponent);
begin
  inherited Create(AOwner);
  Activated := False;
  Ready := False;
  Form := TForm(GetOwnerForm(Self));
  Form.DoubleBuffered := False;

  OldCaption := Form.Caption;
  OldCaption1 := Form.Caption;
  FsStyle := TsPassivePaintStyle.Create(Self);
  FsStyle.SkinSection := NormalForm;
  FsStyle.COC := COC_TsSkinProvider;
  FsBorderIcons := [biSystemMenu, biMinimize, biMaximize];
  TempBmp := TBitmap.Create;
  MenuLineBmp := TBitmap.Create;
  AutoScroll := Form.AutoScroll;
  FMakeSkinMenu := True;
  MenusInitialized := False;
  if not (csDesigning in ComponentState) then begin
    Form.AutoScroll := False;
  end;
  OldInstance := nil;
  NewInstance := nil;

  FormActive := True;
  OldBorderIcons := Form.BorderIcons;

  if (SkinManager = nil) and
       (sSkinData <> nil) and
         (sSkinData.SkinManager <> nil) then begin
    SkinManager := sSkinData.SkinManager;
    if sSkinData.Active and not(csDesigning in ComponentState) then begin
      OldBorderIcons := TForm(Form).BorderIcons;
      TForm(Form).BorderIcons := [];
    end;
  end;

  SystemMenu := TsSystemMenu.Create(Self);
  SystemMenu.FForm := Form;
  SystemMenu.UpdateItems;

  SetLength(ArOR, 0);

  OldBorderStyle := Form.BorderStyle;
end;

destructor TsSkinProvider.Destroy;
begin
  if (Form.FormStyle = fsMDIChild) and Assigned(Form.Menu) then begin
    if Assigned(MDISkinProvider) and
         not (csDestroying in TsSkinProvider(MDISkinProvider).ComponentState) and
         not (csDestroying in TsSkinProvider(MDISkinProvider).Form.ComponentState)
           then begin
      TsSkinProvider(MDISkinProvider).BGChanged := True;
      SendMessage(TsSkinProvider(MDISkinProvider).Form.Handle, WM_NCPAINT, 0, 0);
    end;
  end;

  if MDISkinProvider = Self then begin
    MDISkinProvider := nil;
    if Assigned(MDIForm) then FreeAndNil(MDIForm);
  end;

  if Assigned(Form) then begin if Assigned(Form) and Form.HandleAllocated and
    (Pointer(GetWindowLong(Form.Handle, GWL_WNDPROC)) = NewInstance) then
      SetWindowLong(Form.Handle, GWL_WNDPROC, longint(OldInstance));
  end;

  if Assigned(SystemMenu) then FreeAndNil(SystemMenu);

  OldInstance := nil;
  FreeObjectInstance(pointer(NewInstance));
  NewInstance := nil;
  FreeAndnil(FsStyle);
  if Assigned(TempBmp) then FreeAndnil(TempBmp);
  if Assigned(MenuLineBmp) then FreeAndNil(MenuLineBmp);

//  if Assigned(VSBar) then FreeAndNil(VSBar);
//  if Assigned(HSBar) then FreeAndNil(HSBar);

  inherited Destroy;
end;

procedure TsSkinProvider.RepaintButton(i: integer);
var
  DC, SavedDC : hdc;
  CurButton : TsCaptionButton;
  cx, ind : integer;
begin
  CurButton.State := -1;
  case i of
    HTCLOSE      : begin CurButton := ButtonClose; end;
    HTMAXBUTTON  : begin CurButton := ButtonMax; end;
    HTMINBUTTON  : begin CurButton := ButtonMin; end;
    HTHELP       : begin CurButton := ButtonHelp; end;
    HTCHILDCLOSE : begin CurButton := MDIClose; end;
    HTCHILDMAX   : begin CurButton := MDIMax; end;
    HTCHILDMIN   : begin CurButton := MDIMin; end;
  end;
  if CurButton.State <> -1 then begin
    DC := GetWindowDC(Form.Handle);
    SavedDC := SaveDC(DC);
    cx := sStyle.FCacheBmp.Width - CurButton.Rect.Left;
    try
      BitBlt(sStyle.FCacheBmp.Canvas.Handle,
             CurButton.Rect.Left, CurButton.Rect.Top, Buttonwidth, ButtonHeight,
             TempBmp.Canvas.Handle, TempBmp.Width - cx,
             CurButton.Rect.Top, SRCCOPY);

      if (CurButton.Rect.Left <> ButtonMax.Rect.Left) or (Form.WindowState = wsNormal) then begin
        if IsValidImgIndex(CurButton.ImageIndex) then
          PaintBlendGlyph(sStyle.FCacheBmp, ma[CurButton.ImageIndex].Bmp,
                Point(CurButton.Rect.Left, CurButton.Rect.Top),
                CurButton.State, ma[CurButton.ImageIndex].TransparentColor, 1 + integer(not FormActive) * integer(not (CurButton.State > 0)));
      end
      else begin
        ind := sStyle.GetMaskIndex(BorderIconNormalize);
        if ind > -1 then
          PaintBlendGlyph(sStyle.FCacheBmp, ma[ind].Bmp,
                Point(CurButton.Rect.Left, CurButton.Rect.Top),
                CurButton.State, ma[ind].TransparentColor, 1 + integer(not FormActive) * integer(not (CurButton.State > 0)));
      end;

      BitBlt(DC,
             CurButton.Rect.Left, CurButton.Rect.Top, ButtonWidth, ButtonHeight,
             sStyle.FCacheBmp.Canvas.Handle, CurButton.Rect.Left,
             CurButton.Rect.Top, SRCCOPY);
    finally
      RestoreDC(DC, SavedDC);
      ReleaseDC(Form.Handle, DC);
    end;
  end;
end;

function TsSkinProvider.HTProcess(Message : TWMNCHitTest): integer;
var
  p : TPoint;
  cy1, cy2 : integer;
  i : integer;
begin
  Result := HTNOWHERE;
  p := CursorToPoint(Message.XPos, Message.YPos);
  i := BorderHeight;
  cy1 := (CaptionHeight - ButtonHeight + i) div 2;
  cy2 := cy1 + ButtonHeight;
  // If in buttons
  if Between(p.y, cy1, cy2) then begin
    if Between(p.x, Form.Width - BorderWidth - 1 * (ButtonWidth + 1), Form.Width - BorderWidth - 0 * (ButtonWidth + 1)) then begin
      SetHotHT(HTCLOSE); Result := HTCLOSE; Exit;
    end else
    if Between(p.x, Form.Width - BorderWidth - 2 * (ButtonWidth + 1), Form.Width - BorderWidth - 1 * (ButtonWidth + 1)) and
      (SystemMenu.EnabledMax or SystemMenu.EnabledRestore) and SystemMenu.VisibleMax
      then begin
      SetHotHT(HTMAXBUTTON); Result := HTMAXBUTTON; Exit;
    end else
    if SystemMenu.EnabledMin and Between(p.x, Form.Width - BorderWidth - 3 * (ButtonWidth + 1), Form.Width - BorderWidth - 2 * (ButtonWidth + 1)) and
         SystemMenu.VisibleMin
    then begin
      SetHotHT(HTMINBUTTON); Result := HTMINBUTTON; Exit;
    end else
    if Between(p.x, BorderWidth, BorderWidth + WidthOf(IconRect)) then begin
      SetHotHT(HTSYSMENU); Result := HTSYSMENU; Exit;
    end else
    if (biHelp in FsBorderIcons) and SystemMenu.VisibleMax then begin
      if Between(p.x, Form.Width - BorderWidth - 4 * (ButtonWidth + 1), Form.Width - BorderWidth - 3 * (ButtonWidth + 1)) then begin
        SetHotHT(HTHELP); Result := HTHELP; EXIT;
      end;
    end
    else if p.y < cy2 then begin
      Result := HTCAPTION;
    end;
  end
  else begin
    // MDI child buttons
    if MDIButtonsNeeded then begin
      if PtInRect(MDICLose.Rect, p) then begin
        SetHotHT(HTCHILDCLOSE); Result := HTCHILDCLOSE; Exit;
      end else
      if PtInRect(MDIMax.Rect, p) then begin
        SetHotHT(HTCHILDMAX); Result := HTCHILDMAX; Exit;
      end else
      if PtInRect(MDIMin.Rect, p) then begin
        SetHotHT(HTCHILDMIN); Result := HTCHILDMIN; Exit;
      end
    end else SetHotHT(0);
  end;
  if (Form.WindowState = wsMaximized) and AboveBorder(Message) then Result := HTTRANSPARENT;
end;

procedure TsSkinProvider.InitFormSizes;
begin
  RegionChanged := True;
  CaptChanged := True;
  CaptRgnChanged :=True;
end;

procedure TsSkinProvider.NewWndProc(var Message: TMessage);
var
  MMI: PMinMaxInfo;
  DC, SavedDC : hdc;
  mi :  TMenuItem;
  i : integer;
  p : TPoint;
  m : TMessage;
  R : TRect;
  UpdateClient : boolean;
  cm : TWMCommand;
begin
  if
    (csDestroying in Form.ComponentState) or
      (csDesigning in ComponentState) or
        (SkinManager = nil) or
          (sSkinData.SkinManager = nil) or
            not (sSkinData.Active) or (sStyle.SkinIndex < 0) or Frozen
                then begin
    Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
  end
  else begin
    Message.Result := 0;
    case Message.Msg of
      WM_SYSCOLORCHANGE : begin
        Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
        UpdateMenu;
      end;
      WM_MOVE : begin
        Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
        if (Form.FormStyle = fsMDIChild) and (Form.WindowState <> wsMaximized) then begin
          TsMDIForm(TsSkinProvider(MDISkinProvider).MDIForm).RefreshScrolls;
        end;
      end;
      WM_SIZE : begin
        Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
        if (Form.FormStyle = fsMDIForm) and Assigned(Form.ActiveMDIChild) then begin
//???          SendMessage(TsMDIForm(MDIForm).FForm.ClientHandle, WM_SIZE, 0, 0);
//???          Application.ProcessMessages;
          TsMDIForm(MDIForm).RefreshScrolls;
          if (Form.ActiveMDIChild.WindowState = wsMaximized) then begin
            SendMessage(Form.ActiveMDIChild.Handle, WM_SIZE, 0, 0);
          end
        end
        else begin
          RefreshScrolls;
          // Repaint MDI child buttons
          if (Form.FormStyle = fsMDIChild) then begin
            if (Form.WindowState = wsMaximized) then begin
              TsSkinProvider(MDISkinProvider).BGChanged := (sStyle.FCacheBmp.Width = Form.Width) or (sStyle.FCacheBmp.Height = Form.Height);
              SendMessage(TsSkinProvider(MDISkinProvider).Form.Handle, WM_NCPAINT, 0, 0);
            end
          end;
        end;
      end;
      WM_GETMINMAXINFO : begin
        MMI := PMinMaxInfo(Message.LParam);
        MMI^.ptMaxTrackSize.x := MaxWidth + 6;
        MMI^.ptMaxTrackSize.y := MaxHeight + 6;
        Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
      end;
      WM_NCHITTEST : begin
        if (Form.BorderStyle = bsNone) {or AboveBorder(TWMNCHitTest(Message))} then begin
          Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
        end
        else begin
          Message.Result := HTProcess(TWMNCHitTest(Message));
          case Message.Result of
            HTCaption : begin
              if Form.WindowState <> WSMAXIMIZED then
                Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
              SetHotHT(0);
            end;
            HTNOWHERE : begin
              Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
              SetHotHT(0);
            end;
          end;
        end;
      end;
      WM_SIZING : begin
        Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
        if FormChanged then begin
          if not (csCreating in Form.ControlState) then BGChanged := True;
          if Form.FormStyle = fsMDIForm then begin
            TsMDIForm(MDIForm).RefreshScrolls;
          end;
        end;
      end;
      WM_MOUSELEAVE, CM_MOUSELEAVE : begin
        SetHotHT(0);
        Message.Result := CallWindowProc(pointer(OldInstance), Form.Handle, Message.Msg, Message.wParam, Message.lParam);
      end;

      WM_NCLBUTTONDOWN : begin
        Message.Result := 1;
        case TWMNCLButtonDown(Message).HitTest of
          HTCLOSE, HTMAXBUTTON, HTMINBUTTON, HTHELP, HTCHILDCLOSE..HTCHILDMIN : begin
            SetPressedHT(TWMNCLButtonDown(Message).HitTest);
          end;
          HTSYSMENU : begin
            SetHotHT(0);
            if Form.FormStyle = fsMDIChild then begin
              if Assigned(MDISkinProvider) then begin
                p := Point(Form.Left, Form.Top);
                ClientToScreen(Form.Handle, p);
                DropSysMenu(TsSkinProvider(MDISkinProvider).Form.Left + Form.Left + (BorderWidth + Form.BorderWidth) * 2,
                            TsSkinProvider(MDISkinProvider).Form.Top + Form.Top +
                            TsSkinProvider(MDISkinProvider).BorderHeight +
                               TsSkinProvider(MDISkinProvider).CaptionHeight +
                               TsSkinProvider(MDISkinProvider).LinesCount * TsSkinProvider(MDISkinProvider).MenuHeight * integer(TsSkinProvider(MDISkinProvider).MenuPresent) +
                               TsSkinProvider(MDISkinProvider).Form.BorderWidth + 1 +
                            BorderHeight +

⌨️ 快捷键说明

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