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 + -
显示快捷键?