ksskinobjects.pas
来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 2,327 行 · 第 1/5 页
PAS
2,327 行
function TSeActiveBitmap.GetFont: TFont;
begin
case FState of
ssHot, ssFocused: Result := FActiveFont;
else
Result := inherited GetFont;
end;
end;
procedure TSeActiveBitmap.Draw(Canvas: TCanvas);
var
SaveBitmap: TSeBitmapLink;
begin
if ((FActive) or (FState in [ssFocused, ssHot])) and FActiveBitmap.Assigned then
begin
SaveBitmap := FBitmap;
try
FBitmap := FActiveBitmap;
inherited Draw(Canvas);
finally
FBitmap := SaveBitmap;
end;
end
else
inherited Draw(Canvas);
end;
procedure TSeActiveBitmap.SetActiveBitmap(const Value: TSeBitmapLink);
begin
FActiveBitmap.Assign(Value);
end;
procedure TSeActiveBitmap.SetActiveFont(const Value: TFont);
begin
FActiveFont.Assign(Value);
end;
{ TSeSystemButton }
constructor TSeSystemButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FKind := skSysButton;
FBitmapHot := TSeBitmapLink.Create;
FBitmapPressed := TSeBitmapLink.Create;
end;
destructor TSeSystemButton.Destroy;
begin
FBitmapHot.Free;
FBitmapPressed.Free;
inherited Destroy;
end;
procedure TSeSystemButton.AfterLoad;
var
NewLink: TSeBitmapLink;
begin
inherited AfterLoad;
if FBitmaps <> nil then
begin
{ Hover }
NewLink := FBitmaps.GetBitmapLink(FBitmapHot.Name, FBitmapHot.Rect);
if NewLink <> nil then
begin
FBitmapHot.Free;
FBitmapHot := NewLink;
end;
{ Down }
NewLink := FBitmaps.GetBitmapLink(FBitmapPressed.Name, FBitmapPressed.Rect);
if NewLink <> nil then
begin
FBitmapPressed.Free;
FBitmapPressed := NewLink;
end;
end;
end;
procedure TSeSystemButton.Assign(Source: TPersistent);
begin
if Source is TSeSystemButton then
begin
inherited Assign(Source);
BitmapHot := (Source as TSeSystemButton).BitmapHot;
BitmapPressed := (Source as TSeSystemButton).BitmapPressed;
FAction := (Source as TSeSystemButton).FAction;
end
else
inherited;
end;
procedure TSeSystemButton.SetState(const Value: TSeState);
var
SkinForm: TSeSkinForm;
begin
inherited SetState(Value);
SkinForm := TSeSkinForm(GetSkinForm);
if SkinForm = nil then Exit;
case FState of
ssNormal: begin
Visible := true;
if FAction = sbaRestore then Visible := false;
if FAction = sbaRollDown then Visible := false;
end;
ssMaximized: begin
Visible := true;
if FAction = sbaMaximize then Visible := false;
if FAction = sbaRollDown then Visible := false;
end;
ssMinimized: begin
Visible := true;
if FAction = sbaMinimize then Visible := false;
if FAction = sbaMaximize then Visible := false;
if FAction = sbaRollUp then Visible := false;
if FAction = sbaRollDown then Visible := false;
end;
ssRollup: begin
Visible := true;
if FAction = sbaRestore then Visible := false;
if FAction = sbaRollUp then Visible := false;
end;
end;
case FAction of
sbaNone: ;
sbaClose: if not (kbiClose in SkinForm.BorderIcons) then Visible := false;
sbaHelp: if not (kbiHelp in SkinForm.BorderIcons) then Visible := False;
sbaMinimize: if not (kbiMinimize in SkinForm.BorderIcons) then Visible := False;
sbaMaximize: if not (kbiMaximize in SkinForm.BorderIcons) then Visible := False;
sbaRestore: if not (kbiMaximize in SkinForm.BorderIcons) then Visible := False;
sbaRollUp: if not (kbiRollUp in SkinForm.BorderIcons) then Visible := False;
sbaRollDown: if not (kbiRollUp in SkinForm.BorderIcons) then Visible := False;
sbaTray: if not (kbiTray in SkinForm.BorderIcons) then Visible := False;
sbaSysMenu: if not (kbiSystemMenu in SkinForm.BorderIcons) then Visible := False;
sbaRollPanel: ;
end;
end;
procedure TSeSystemButton.DoAction;
var
SkinForm: TSeSkinForm;
SkinObject: TSeSkinObject;
OwnerObject: TSeSkinObject;
begin
SkinForm := TSeSkinForm(GetSkinForm);
case FAction of
sbaClose: if SkinForm <> nil then begin
SkinForm.Close;
end;
sbaHelp: if SkinForm <> nil then begin
SkinForm.Help;
end;
sbaMinimize: if SkinForm <> nil then begin
SkinForm.Minimize;
end;
sbaMaximize: if SkinForm <> nil then begin
SkinForm.Maximize;
end;
sbaRestore: if SkinForm <> nil then begin
SkinForm.Restore;
end;
sbaRollup: if SkinForm <> nil then begin
SkinForm.Rollup;
end;
sbaRollDown: if SkinForm <> nil then begin
SkinForm.Restore;
end;
sbaTray: if SkinForm <> nil then begin
SkinForm.MinToTray;
end;
sbaSysMenu: if SkinForm <> nil then begin
SkinForm.SysMenu;
end;
sbaCustom: if SkinForm <> nil then
if Assigned(SkinForm.OnCustomAction) then SkinForm.OnCustomAction(Self);
end;
end;
procedure TSeSystemButton.Draw(Canvas: TCanvas);
var
SaveBitmap: TSeBitmapLink;
IHandle, IHandle2 : HICON;
IconX, IconY : integer;
ID: boolean;
R: TRect;
SaveActive: boolean;
begin
if FWidth <= 0 then Exit;
if FHeight <= 0 then Exit;
if FAction = sbaSysMenu then
begin
if FParentControl = nil then Exit;
if not (FParentControl is TForm) then Exit;
R := BoundsRect;
ID := false;
if TForm(FParentControl).Icon.Handle <> 0 then
IHandle := TForm(FParentControl).Icon.Handle
else
if Application.Icon.Handle <> 0 then
IHandle := Application.Icon.Handle
else
begin
IHandle := LoadIcon(0, IDI_APPLICATION);
ID := true;
end;
IconX := GetSystemMetrics(SM_CXSMICON);
if IconX = 0 then IconX := GetSystemMetrics(SM_CXSIZE);
IconY := GetSystemMetrics(SM_CYSMICON);
if IconY = 0 then IconY := GetSystemMetrics(SM_CYSIZE);
IHandle2 := CopyImage(IHandle, IMAGE_ICON, IconX, IconY, LR_COPYFROMRESOURCE);
DrawIconEx(Canvas.Handle, R.Left, R.Top, IHandle2, 0, 0, 0, 0, DI_NORMAL);
DestroyIcon(IHandle2);
if ID then DestroyIcon(IHandle);
Exit;
end;
if (not Active) then
begin
try
SetChildState(ssDisabled);
inherited Draw(Canvas);
finally
SetChildState(ssNormal);
end;
end
else
case FButtonState of
bsNormal: begin
inherited Draw(Canvas);
end;
bsHover: begin
SaveBitmap := FBitmap;
try
if FBitmapHot.Assigned then
FBitmap := FBitmapHot;
SaveActive := FActive;
try
Active := false;
SetChildState(ssHot);
inherited Draw(Canvas);
finally
Active := SaveActive;
SetChildState(ssNormal);
end;
finally
FBitmap := SaveBitmap;
end;
end;
bsDown: begin
SaveBitmap := FBitmap;
try
if FBitmapPressed.Assigned then
FBitmap := FBitmapPressed;
SaveActive := FActive;
try
Active := false;
SetChildState(ssPressed);
inherited Draw(Canvas);
finally
SetChildState(ssNormal);
Active := SaveActive;
end;
finally
FBitmap := SaveBitmap;
end;
end;
end;
end;
procedure TSeSystemButton.SetChildState(const Value: TSeState);
var
i: integer;
begin
if Count = 0 then Exit;
for i := 0 to Count-1 do
Objects[i].State := Value;
end;
procedure TSeSystemButton.MouseHover;
begin
if ssLeft in FShift then
FButtonState := bsDown
else
FButtonState := bsHover;
Invalidate;
end;
procedure TSeSystemButton.MouseLeave;
begin
FButtonState := bsNormal;
Invalidate;
end;
procedure TSeSystemButton.MouseDouble(Button: TMouseButton; X, Y: integer);
var
SkinForm: TSeSkinForm;
SkinObject: TSeSkinObject;
OwnerObject: TSeSkinObject;
begin
if (Button = mbLeft) and (FAction = sbaSysMenu) then
begin
SkinForm := TSeSkinForm(GetSkinForm);
if SkinForm <> nil then
SkinForm.Close;
end;
end;
procedure TSeSystemButton.MouseDown(Button: TMouseButton; X,
Y: integer);
begin
if Button = mbLeft then
begin
FButtonState := bsDown;
Invalidate;
end;
end;
procedure TSeSystemButton.MouseMove(Shift: TShiftState; X,
Y: integer);
var
Pos: TPoint;
begin
if (FButtonState = bsDown) and (ssLeft in Shift) then
begin
FButtonState := bsDown;
Invalidate;
end
else
begin
{ Show Hint }
Pos := Point(Left, Top);
if FParentControl <> nil then
Pos := FParentControl.ClientToScreen(Pos);
{$IFDEF KS_COMPILER5_UP}
Application.ActivateHint(Pos);
{$ENDIF}
end;
FShift := Shift;
end;
procedure TSeSystemButton.MouseUp(Button: TMouseButton; X,
Y: integer);
begin
if (FButtonState = bsDown) and (Button = mbLeft) then
begin
FButtonState := bsHover;
Invalidate;
DoAction;
end;
FShift := [];
end;
procedure TSeSystemButton.SetAction(const Value: TSeAction);
begin
FAction := Value;
end;
procedure TSeSystemButton.SetBitmapPressed(const Value: TSeBitmapLink);
begin
FBitmapPressed.Assign(Value);
end;
procedure TSeSystemButton.SetBitmapHot(const Value: TSeBitmapLink);
begin
FBitmapHot.Assign(Value);
end;
{ TSeButtonObject =============================================================}
constructor TSeButtonObject.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBitmapFocused := TSeBitmapLink.Create;
FBitmapHot := TSeBitmapLink.Create;
FBitmapPressed := TSeBitmapLink.Create;
FBitmapDisabled := TSeBitmapLink.Create;
end;
destructor TSeButtonObject.Destroy;
begin
FBitmapFocused.Free;
FBitmapHot.Free;
FBitmapPressed.Free;
FBitmapDisabled.Free;
inherited Destroy;
end;
procedure TSeButtonObject.AfterLoad;
var
NewLink: TSeBitmapLink;
begin
inherited AfterLoad;
if FBitmaps <> nil then
begin
{ Focused }
NewLink := FBitmaps.GetBitmapLink(FBitmapFocused.Name, FBitmapFocused.Rect);
if NewLink <> nil then
begin
FBitmapFocused.Free;
FBitmapFocused := NewLink;
end;
{ Hot }
NewLink := FBitmaps.GetBitmapLink(FBitmapHot.Name, FBitmapHot.Rect);
if NewLink <> nil then
begin
FBitmapHot.Free;
FBitmapHot := NewLink;
end;
{ Pressed }
NewLink := FBitmaps.GetBitmapLink(FBitmapPressed.Name, FBitmapPressed.Rect);
if NewLink <> nil then
begin
FBitmapPressed.Free;
FBitmapPressed := NewLink;
end;
{ Disabled }
NewLink := FBitmaps.GetBitmapLink(FBitmapDisabled.Name, FBitmapDisabled.Rect);
if NewLink <> nil then
begin
FBitmapDisabled.Free;
FBitmapDisabled := NewLink;
end;
end;
end;
procedure TSeButtonObject.Assign(Source: TPersistent);
begin
if Source is TSeButtonObject then
begin
inherited Assign(Source);
BitmapFocused := (Source as TSeButtonObject).BitmapFocused;
BitmapHot := (Source as TSeButtonObject).BitmapHot;
BitmapDisabled := (Source as TSeButtonObject).BitmapDisabled;
BitmapPressed := (Source as TSeButtonObject).BitmapPressed;
end
else
inherited;
end;
procedure TSeButtonObject.Draw(Canvas: TCanvas);
var
SaveBitmap: TSeBitmapLink;
begin
if not FB
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?