ssplitter.pas

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

      end;

    end;
  end;
end;

procedure TsSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  AllowChange: Boolean;
begin
  inherited MouseMove(Shift, X, Y);
  if (GetCapture = Handle) and FSizing then begin
    AllowChange := True;
    Changing(X, Y, AllowChange);
    case ResizeStyle of
      srsUpdate : begin
        MoveAndUpdate(X, Y, AllowChange);
      end;
      srsInverseLine : begin
        MoveInverseRect(X, Y, AllowChange);
      end;
    end;
  end;
end;

procedure TsSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  StopSizing(X, Y, True);
  inherited MouseUp(Button, Shift, X, Y);
  if ResizeStyle = srsUpdate then FCommonData.Invalidate;
end;

procedure TsSplitter.MoveAndUpdate(X, Y: Integer; AllowChange: Boolean);
const
  DecSize = 3;
var
  P: TPoint;
  NoDrop: Boolean;
  NewSize : integer;
  H, W : integer;
  R : TRect;
  i : integer;
begin
  CheckPosition(X, Y);
  if Parent = nil then Exit;
  R := Parent.ClientRect;
  H := R.Bottom - R.Top - Height;
  W := R.Right - R.Left - Width;
  if not AllowChange then begin
    P := ScreenToClient(FPrevOrg);
    X := P.X + FOffset.X - Width div 2;
    Y := P.Y + FOffset.Y - Height div 2
  end;
  if (ControlFirst.Align = alRight) or ((ControlSecond <> nil) and (ControlSecond.Align = alRight)) then begin
    X := -X;
    FOffset.X := -FOffset.X;
  end;
  if (ControlFirst.Align = alBottom) or ((ControlSecond <> nil) and (ControlSecond.Align = alBottom)) then begin
    Y := -Y;
    FOffset.Y := -FOffset.Y;
  end;
  Parent.DisableAlign;
  try
    if FStyle = spHorizontalFirst then begin
      NewSize := ControlFirst.Height + Y - FOffset.Y;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= H then NewSize := H - DecSize;
      ControlFirst.Height := NewSize;
    end
    else if FStyle = spHorizontalSecond then begin
      NewSize := ControlSecond.Height + Y - FOffset.Y;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= H then NewSize := H - DecSize;
      ControlSecond.Height := NewSize;
    end
    else if FStyle = spVerticalFirst then begin
      NewSize := ControlFirst.Width + X - FOffset.X;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= W then NewSize := W - DecSize;
      ControlFirst.Width := NewSize;
    end
    else if FStyle = spVerticalSecond then begin
      NewSize := ControlSecond.Width + X - FOffset.X;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= W then NewSize := W - DecSize;
      ControlSecond.Width := NewSize;
    end;
  finally
    Parent.EnableAlign;
    for i := 0 to Parent.ControlCount - 1 do begin
      Parent.Controls[i].Repaint;    
    end;
//    if Assigned(ControlFirst) then ControlFirst.Repaint;
//    if Assigned(ControlSecond) then ControlSecond.Repaint;
  end;

  P := Point(X, Y);
  NoDrop := not AllowChange or (((X <> P.X) and (FStyle in [spVerticalFirst,
              spVerticalSecond])) or ((Y <> P.Y) and (FStyle in [spHorizontalFirst,
                spHorizontalSecond])));
  if NoDrop <> FNoDropCursor then begin
    FNoDropCursor := NoDrop;
    if NoDrop
      then SetCursor(Screen.Cursors[crNoDrop])
      else SetCursor(Screen.Cursors[Cursor]);
  end;
  ShowInverseRect(X - FOffset.X + Width div 2, Y - FOffset.Y + Height div 2, imMove);
end;

procedure TsSplitter.MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
var
  P: TPoint;
  NoDrop: Boolean;
begin
  if not AllowChange then begin
    SetCursor(Screen.Cursors[crNoDrop]);
    Exit;
  end;
  P := Point(X, Y);
  CheckPosition(X, Y);
  NoDrop := not AllowChange or (((X <> P.X) and (FStyle in [spVerticalFirst,
              spVerticalSecond])) or ((Y <> P.Y) and (FStyle in [spHorizontalFirst,
                spHorizontalSecond])));
  if NoDrop <> FNoDropCursor then begin
    FNoDropCursor := NoDrop;
    if NoDrop
      then SetCursor(Screen.Cursors[crNoDrop])
      else SetCursor(Screen.Cursors[Cursor]);
  end;
  ShowInverseRect(X - FOffset.X + Width div 2, Y - FOffset.Y + Height div 2, imMove);
end;

procedure TsSplitter.Notification(AComponent: TComponent; AOperation: TOperation);
begin
  inherited Notification(AComponent, AOperation);
  if AOperation = opRemove then begin
    if AComponent = ControlFirst then ControlFirst := nil
    else if AComponent = ControlSecond then ControlSecond := nil;
  end;
end;

procedure TsSplitter.Paint;
var
  R: TRect;
  CI : TCacheInfo;
  State : integer;
begin
  R := ClientRect;
  Canvas.Brush.Color := Color;
  FCommonData.FCacheBmp.Width := Width;
  FCommonData.FCacheBmp.Height := Height;
  CI := GetParentCache(FCOmmonData);
  State := integer(FCommonData.ControlIsActive);
  if FSizing and (ResizeStyle = srsUpdate) then State := 2; 
  sGraphUtils.PaintItem(FCommonData.SkinIndex, FCommonData.SkinSection, CI, True, State, R, Point(Left, Top), FCommonData.FCacheBmp);

  BitBlt(Canvas.Handle, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0,0, SRCCOPY);
end;

procedure TsSplitter.ReadOffset(Reader: TReader);
var
  I: Integer;
begin
  I := Reader.ReadInteger;
  FTopLeftLimit := I;
  FBottomRightLimit := I;
end;

procedure TsSplitter.SetAlign(Value: TAlign);
begin
  if not (Align in [alTop, alBottom, alLeft, alRight]) then begin
    inherited Align := Value;
    if not (csReading in ComponentState) then begin
      if Value in [alTop, alBottom] then Height := DefWidth
      else if Value in [alLeft, alRight] then Width := DefWidth;
    end;
  end
  else inherited Align := Value;
  if (ControlFirst = nil) and (ControlSecond = nil) then
    ControlFirst := FindControl;
end;

procedure TsSplitter.SetControlFirst(Value: TControl);
begin
  if Value <> FControlFirst then begin
    if (Value = Self) or (Value is TForm) then FControlFirst := nil
    else begin
      FControlFirst := Value;
      if Value <> nil then Value.FreeNotification(Self);
    end;
    UpdateState;
  end;
end;

procedure TsSplitter.SetControlSecond(Value: TControl);
begin
  if Value <> FControlSecond then begin
    if (Value = Self) or (Value is TForm) then FControlSecond := nil
    else begin
      FControlSecond := Value;
      if Value <> nil then Value.FreeNotification(Self);
    end;
    UpdateState;
  end;
end;

procedure TsSplitter.ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
var
  P: TPoint;
  MaxRect: TRect;
  Horiz: Boolean;
begin
  P := Point(0, 0);
  if FStyle in [spHorizontalFirst, spHorizontalSecond] then begin
    P.Y := Y;
    Horiz := True;
  end
  else begin
    P.X := X;
    Horiz := False;
  end;
  MaxRect := Parent.ClientRect;
  P := ClientToScreen(P);
  with P, MaxRect do begin
    TopLeft := Parent.ClientToScreen(TopLeft);
    BottomRight := Parent.ClientToScreen(BottomRight);
    if X < Left then X := Left;
    if X > Right then X := Right;
    if Y < Top then Y := Top;
    if Y > Bottom then Y := Bottom;
  end;
  if (Mode = imMove) then if ((P.X = FPrevOrg.X) and not Horiz) or ((P.Y = FPrevOrg.Y) and Horiz) then Exit;
  if Mode in [imClear, imMove] then DrawSizingLine(FPrevOrg);
  if Mode in [imNew, imMove] then begin
    DrawSizingLine(P);
    FPrevOrg := P;
  end;
end;

procedure TsSplitter.StartInverseRect;
var
  R: TRect;
  W: Integer;
begin
  if Parent = nil then Exit;
  Application.ProcessMessages;
  R := Parent.ClientRect;
  FLimitRect.TopLeft := CToC(Self, Parent, Point(R.Left + FTopLeftLimit, R.Top + FTopLeftLimit));
  FLimitRect.BottomRight := CToC(Self, Parent, Point(R.Right - R.Left - FBottomRightLimit, R.Bottom - R.Top - FBottomRightLimit));
  FNoDropCursor := False;
  FForm := ValidParentForm(Self);
  FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE);

  with FForm.Canvas do begin
    Pen.Color := clWhite;
    if FStyle in [spHorizontalFirst, spHorizontalSecond]
      then W := Height
      else W := Width;
    if W > InverseThickness + 1
      then W := W - InverseThickness
      else W := InverseThickness;
    Pen.Width := W;
    Pen.Mode := pmXOR;
  end;
  ShowInverseRect(Width div 2, Height div 2, imNew);
end;

procedure TsSplitter.StartMoving;
var
  R: TRect;
//  W: Integer;
begin
  if Parent = nil then Exit;
  R := Parent.ClientRect;
  FLimitRect.TopLeft := CToC(Self, Parent, Point(R.Left + FTopLeftLimit, R.Top + FTopLeftLimit));
  FLimitRect.BottomRight := CToC(Self, Parent, Point(R.Right - R.Left - FBottomRightLimit, R.Bottom - R.Top - FBottomRightLimit));
  FNoDropCursor := False;
end;

procedure TsSplitter.StopSizing(X, Y: Integer; Apply: Boolean);
var
  AllowChange: Boolean;
begin
  if FSizing then begin
    ReleaseCapture;
    AllowChange := Apply;
    if Apply then Changing(X, Y, AllowChange);
    EndInverseRect(X, Y, AllowChange, Apply);
    FSizing := False;
    Application.ShowHint := FAppShowHint;
    if Assigned(FActiveControl) then begin
      TWC(FActiveControl).OnKeyDown := FOldKeyDown;
      FActiveControl := nil;
    end;
    if Apply then Changed;
  end;
end;

procedure TsSplitter.UpdateState;
begin
  inherited Cursor := Cursor;
end;

procedure TsSplitter.WndProc(var Message: TMessage);
begin
  if not ControlIsReady(Self) then inherited
  else begin
    if Assigned(FCommonData) and FCommonData.Skinned then
      case Message.Msg of
        WM_NCPAINT : begin
          Message.Result := 1;
        end;
        WM_SIZE, WM_MOVE : begin
          FCommonData.BGChanged := True;
          FCommonData.RegionChanged := True;
          Repaint;
        end;
        WM_ERASEBKGND : begin
          Message.Result := 1;
        end;
        SM_GETCACHE : begin
          GlobalCacheInfo.Bmp := FCommonData.FCacheBmp;
          GlobalCacheInfo.X := 0;
          GlobalCacheInfo.Y := 0;
          GlobalCacheInfo.Ready := True;
          Message.Result := 1;
        end;
        SM_REMOVESKIN : if not (csDestroying in ComponentState) then begin
          FCommonData.BorderIndex := -1;
          FCommonData.SkinIndex := -1;
          FCommonData.RegionChanged := True;
          Refresh;
        end;
      end;
    if Message.Result <> 1 then begin
      if Assigned(FCommonData) then begin
        FCommonData.WndProc(Message);
        if FCommonData.Skinned then begin
          case Message.Msg of
            CM_VISIBLECHANGED, WM_SIZE, CM_ENABLEDCHANGED, WM_MOUSEWHEEL, WM_MOVE : if FCommonData.Skinned then begin
              FCommonData.BGChanged := True;
              Repaint;
              SendMessage(Handle, WM_NCPAINT, 0, 0);
            end;
            WM_SETFOCUS, CM_ENTER, WM_KILLFOCUS, CM_EXIT: if FCommonData.Skinned then begin
              FCommonData.FFocused := (Message.Msg = CM_ENTER) or (Message.Msg = WM_SETFOCUS);
              FCommonData.FMouseAbove := False;
              FCommonData.BGChanged := True;
              Repaint;
              SendMessage(Handle, WM_NCPAINT, 0, 0);
            end;
            WM_VSCROLL : begin
              exit;
            end;
            CM_MOUSELEAVE, CM_MOUSEENTER : begin
              if not FCommonData.FFocused and not(csDesigning in ComponentState) then begin
                FCommonData.FMouseAbove := Message.Msg = CM_MOUSEENTER;
                FCommonData.BGChanged := True;
                SendMessage(Handle, WM_NCPAINT, 0, 0);
                Repaint;
              end;
            end;
          end;
        end;
      end;
   end;
    if Message.Result <> 1 then begin
      inherited;
    end;
  end;
end;

procedure TsSplitter.WriteOffset(Writer: TWriter);
begin
  Writer.WriteInteger(FTopLeftLimit);
end;

end.