?? ssplitter.pas
字號:
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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -