smdiform.pas

AlphaControls是一个Delphi标准控件的集合

unit sMDIForm;

interface

{$I sDefs.inc}

{$IFDEF DELPHI6UP}
{$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sSkinProvider, sScrollBar, sPanel, sCommonData, Menus;

type

  TswLayout = (swTile, swStretch, swCenter);

  TsMDIForm = class(TPersistent)
  private
    FDefClientProc: TFarProc;
    FClientInstance: Pointer;
    VSBar : TsScrollBar;
    HSBar : TsScrollBar;
    Grip : TsGrip;

    procedure ConnectToClient;
    procedure ClientWndProc(var Message: TMessage);
    procedure OnVSBChange(Sender : TObject; OldValue : integer);
    procedure OnHSBChange(Sender : TObject; OldValue : integer);
    procedure OnSBMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  public
    FForm: TForm;
    ChildIconItem : TMenuItem;
    SkinProvider : TsSkinProvider;

    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    procedure Invalidate;
    function MakeChildIconItem : TMenuItem;
    function FillScrollInfo(bar : integer; var si : TScrollInfo; var sbi : TScrollBarInfo) : boolean;
    procedure RefreshScrolls;
    procedure UpdateMDIIconItem;

    procedure RestoreClick(Sender: TObject);
    procedure MinClick(Sender: TObject);
    procedure CloseClick(Sender: TObject);
    function Left : integer;
    function Top : integer;
    function Width : integer;
    function Height : integer;
    function Offset(Align: TAlign) : integer;
  published
  end;

implementation

uses sUtils, sVCLUtils, sGraphUtils, sConst, sSkinProps, sStyleSimply,
  math, sMaskData, sSkinMenus, sStrings;

var
  ScrollChanging : boolean;
  CurrentVMin, CurrentHMin : integer;

{ TsMDIForm }

procedure TsMDIForm.ClientWndProc(var Message: TMessage);
var
  W, H, l, t: Integer;
  DC, SaveDDC : HDC;
  procedure PaintClient(DC : HDC);
  begin
    w := FForm.ClientWidth - Offset(alLeft) - Offset(alRight) + 4;
    h := FForm.ClientHeight - Offset(alTop) - Offset(alBottom) + 4;
    l := Left;
    t := Top;
    BitBlt(DC,
           0, 0, w, h,
           SkinProvider.sStyle.FCacheBmp.Canvas.Handle,
           Left + 2,
           Top + 2,
           SRCCOPY);
  end;
  procedure PaintBorders(DC : HDC);
  begin
    w := FForm.ClientWidth - Offset(alLeft) - Offset(alRight);
    h := FForm.ClientHeight - Offset(alTop) - Offset(alBottom);
    l := Left;
    t := Top;
{ 
    FillDC(DC, Rect(0, 0, w, 2), clRed);
    FillDC(DC, Rect(0, 2, 2, h), clgreen);
    FillDC(DC, Rect(2, h - 2, w, h), clYellow);
    FillDC(DC, Rect(w - 2, 0, w, h), clBlue);
}
    // Top border
    BitBlt(DC, 0, 0, w, 2, SkinProvider.sStyle.FCacheBmp.Canvas.Handle, l, t, SRCCOPY);
    // Left border
    BitBlt(DC, 0, 2, 2, h, SkinProvider.sStyle.FCacheBmp.Canvas.Handle, l, t + 2, SRCCOPY);
    // Bottom border
    BitBlt(DC, 2, h - 2, w, h, SkinProvider.sStyle.FCacheBmp.Canvas.Handle, l + 2, t + h - 2, SRCCOPY);
    // Right border
    BitBlt(DC, w - 2, 2, w, h - 2, SkinProvider.sStyle.FCacheBmp.Canvas.Handle, l + w - 2, t + 2, SRCCOPY);

  end;
begin
  if IsValidSkinIndex(SkinProvider.sStyle.SkinIndex) and Assigned(SkinProvider) then begin
    case Message.Msg of

//      WM_FONTCHANGE, WM_SETFONT : alert;
      WM_NCPAINT: begin
        if assigned(SkinProvider.Form.ActiveMDIChild) and (SkinProvider.Form.ActiveMDIChild.WindowState = wsMaximized) then begin
          if SkinProvider.Form.ActiveMDIChild.ControlCount > 0 then begin
            RepaintsControls(SkinProvider.Form.ActiveMDIChild, False);
          end;
        end
        else begin
          DC := GetWindowDC(FForm.ClientHandle);
          try
            PaintBorders(DC);
          finally
            ReleaseDC(FForm.ClientHandle, DC);
          end;
        end;
        Message.Result := 1;
      end;
      WM_ERASEBKGND:  begin
        Message.Result := 1;
        if assigned(SkinProvider.Form.ActiveMDIChild) and (SkinProvider.Form.ActiveMDIChild.WindowState = wsMaximized) then Exit;
        FForm.Canvas.Handle := TWMEraseBkGnd(Message).DC;
        SavedDC := SaveDC(FForm.Canvas.Handle);
        try
          PaintClient(FForm.Canvas.Handle);
        finally
          RestoreDC(FForm.Canvas.Handle, SavedDC);
          FForm.Canvas.Handle := 0;
        end;
      end;
      WM_VSCROLL, WM_HSCROLL, WM_SIZE : begin
        Message.Result := CallWindowProc(FDefClientProc, FForm.ClientHandle, Message.Msg, Message.wParam, Message.lParam);
        InvalidateRect(FForm.ClientHandle, NIL, True);
      end
      else begin
        Message.Result := CallWindowProc(FDefClientProc, FForm.ClientHandle, Message.Msg, Message.wParam, Message.lParam);
      end;
    end;
  end
  else Message.Result := CallWindowProc(FDefClientProc, FForm.ClientHandle, Message.Msg, Message.wParam, Message.lParam);
end;

procedure TsMDIForm.ConnectToClient;
var
  l : longint;
begin
  FClientInstance := MakeObjectInstance(ClientWndProc);
  l := GetWindowLong(FForm.ClientHandle, GWL_WNDPROC);
  if l = 0 then exit;
  FDefClientProc := Pointer(l);
  l := Longint(FClientInstance);
  SetWindowLong(FForm.ClientHandle, GWL_WNDPROC, l);
end;

constructor TsMDIForm.Create(AOwner: TPersistent);
begin
  inherited Create;
  SkinProvider := TsSkinProvider(AOwner);

  FForm := SkinProvider.Form;
  if FForm = nil then begin
    Exit;
  end;
  FForm.HandleNeeded;

  ChildIconItem := MakeChildIconItem;

  ConnectToClient;
end;

destructor TsMDIForm.Destroy;
begin
  if Assigned(FForm) then begin
    SetWindowLong(FForm.ClientHandle, GWL_WNDPROC, Longint(FDefClientProc));
    FreeObjectInstance(FClientInstance);
  end;
  inherited Destroy;
end;

function TsMDIForm.FillScrollInfo(bar: integer; var si: TScrollInfo; var sbi : TScrollBarInfo): boolean;
begin
  Result := False;

  case bar of
    SB_VERT : begin
      CurrentVMin := 0;
      SBI.cbSize := SizeOf(TScrollBarInfo);
      SI.cbSize := SizeOf(TScrollInfo);
      SI.fMask := SIF_ALL;

      if GetScrollInfo(FForm.ClientHandle, SB_VERT, SI) and GetScrollBarInfo(FForm.ClientHandle, Integer(OBJID_VSCROLL), SBI) then begin
        if (SBI.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
           (SBI.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) then        //if False {or (SI.nMax < SI.nMin)} {or (SI.nMax - si.nMin = 0) or (SI.nMax - integer(SI.nPage) - CurrentVMin = 0)} then begin
        else begin
          CurrentVMin := si.nMin;
          if (CurrentVMin < 0) and (si.nMax < integer(si.nPage)) then begin
            si.nMax := max(SI.nPos - CurrentVMin, 1);
            si.nPage := si.nMax + 1;
          end else begin
            si.nMax := SI.nMax - integer(SI.nPage) - CurrentVMin + 1;
          end;
          si.nPos := SI.nPos - CurrentVMin;
          si.nMin := 0;

          dec(SBi.rcScrollBar.Top, 2);
          inc(SBi.rcScrollBar.Bottom, 2);
          inc(SBi.rcScrollBar.Right, 1);
          Result := True;
        end;
      end;
    end;
    SB_HORZ : begin
      CurrentHMin := 0;
      SBI.cbSize := SizeOf(TScrollBarInfo);
      SI.cbSize := SizeOf(TScrollInfo);
      SI.fMask := SIF_ALL;

      if GetScrollInfo(FForm.ClientHandle, SB_HORZ, SI) and GetScrollBarInfo(FForm.ClientHandle, Integer(OBJID_HSCROLL), SBI) then begin
        if (SBI.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
           (SBI.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) then        //if False {or (SI.nMax < SI.nMin)} {or (SI.nMax - si.nMin = 0) or (SI.nMax - integer(SI.nPage) - CurrentVMin = 0)} then begin
        else begin
          CurrentHMin := si.nMin;
          if (CurrentHMin < 0) and (si.nMax < integer(si.nPage)) then begin
            si.nMax := max(SI.nPos - CurrentHMin, 1);
            si.nPage := si.nMax + 1;
          end else begin
            si.nMax := SI.nMax - integer(SI.nPage) - CurrentHMin + 1;
            if si.nMax = CurrentHMin then begin
              si.nMax := si.nMax + 1;
              Exit;
            end;
          end;
          si.nPos := SI.nPos - CurrentHMin;
          si.nMin := 0;

          inc(SBi.rcScrollBar.Bottom, 2);
          inc(SBi.rcScrollBar.Right, 1);
          dec(SBi.rcScrollBar.Left, 1);
          Result := True;
        end;
      end;
    end;
  end;
  if not sSkinData.Active then begin
    if Assigned(VSBar) then FreeAndNil(VSBar);
    if Assigned(HSBar) then FreeAndNil(HSBar);
    Exit;
  end;
end;

procedure TsMDIForm.Invalidate;
var
  Msg: TWMEraseBkgnd;
begin
  Msg.Msg := wm_EraseBkgnd;
  Msg.Unused := 0;
  Msg.Result := 0;
  Msg.DC := GetDC(FForm.ClientHandle);
  try
    ClientWndProc(TMessage(Msg));
  finally