ksskinobjects2.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 1,638 行 · 第 1/3 页

  if Source is TSeFormBitmapSkinObject then
  begin
    inherited Assign(Source);
    FInactiveBitmap.Assign((Source as TSeFormBitmapSkinObject).InactiveBitmap);
  end
  else
    inherited;
end;

procedure TSeFormBitmapSkinObject.Draw(Canvas: TCanvas);
var
  SaveBitmap: TSeBitmapLink;
begin
  if (not Active) and (InactiveBitmap.Assigned) then
  begin
    SaveBitmap := FBitmap;
    try
      FBitmap := FInactiveBitmap;
      inherited Draw(Canvas);
    finally
      FBitmap := SaveBitmap;
    end;
  end
  else
    inherited Draw(Canvas);
end;

procedure TSeFormBitmapSkinObject.MouseHover;
begin
  inherited;

end;

procedure TSeFormBitmapSkinObject.MouseLeave;
begin
  inherited;

end;

procedure TSeFormBitmapSkinObject.SetInactiveBitmap(
  const Value: TSeBitmapLink);
begin
  FInactiveBitmap.Assign(Value);
end;

{ TSeSysButtonSkinObject }

constructor TSeSysButtonSkinObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Kind := skSysButton;

  FBitmapHover := TSeBitmapLink.Create;
  FBitmapDown := TSeBitmapLink.Create;
end;

destructor TSeSysButtonSkinObject.Destroy;
begin
  FBitmapHover.Free;
  FBitmapDown.Free;
  inherited Destroy;
end;

procedure TSeSysButtonSkinObject.AfterLoad;
var
  NewLink: TSeBitmapLink;
begin
  inherited AfterLoad;
  if Bitmaps <> nil then
  begin
    { Hover }
    NewLink := Bitmaps.GetBitmapLink(FBitmapHover.Name, FBitmapHover.Rect);
    if NewLink <> nil then
    begin
      FBitmapHover.Free;
      FBitmapHover := NewLink;
    end;
    { Down }
    NewLink := Bitmaps.GetBitmapLink(FBitmapDown.Name, FBitmapDown.Rect);
    if NewLink <> nil then
    begin
      FBitmapDown.Free;
      FBitmapDown := NewLink;
    end;
  end;
end;

procedure TSeSysButtonSkinObject.Assign(Source: TPersistent);
begin
  if Source is TSeSysButtonSkinObject then
  begin
    inherited Assign(Source);
    FBitmapHover.Assign((Source as TSeSysButtonSkinObject).BitmapHover);
    FBitmapDown.Assign((Source as TSeSysButtonSkinObject).BitmapDown);
    FAction := (Source as TSeSysButtonSkinObject).FAction;
    FRollPanel := (Source as TSeSysButtonSkinObject).FRollPanel;
  end
  else
    inherited;
end;

procedure TSeSysButtonSkinObject.SetState(const Value: TSeState);
var
  SkinForm: TSeSkinForm;
begin
  inherited SetState(Value);

  SkinForm := TSeSkinForm(GetSkinForm);

  if SkinForm = nil then Exit;

  case State 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 TSeSysButtonSkinObject.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;
    sbaRollPanel: if SkinForm <> nil then begin
      { Roll}
      OwnerObject := Self;
      while OwnerObject.Owner <> nil do
        OwnerObject := (OwnerObject.Owner as TSeSkinObject);
        
      SkinObject := OwnerObject.FindObjectByName(FRollPanel);
      if SkinObject is TSeRollPanelObject then
        with SkinObject as TSeRollPanelObject do
          Roll;
    end;
    sbaCustom: if SkinForm <> nil then
      if Assigned(SkinForm.OnCustomAction) then SkinForm.OnCustomAction(Self);
  end;
end;

procedure TSeSysButtonSkinObject.Draw(Canvas: TCanvas);
var
  SaveBitmap: TSeBitmapLink;
  IHandle, IHandle2 : HICON;
  IconX, IconY : integer;
  ID: boolean;
  R: TRect;
begin
  if Width <= 0 then Exit;
  if Height <= 0 then Exit;

  if Action = sbaSysMenu then
  begin
    if ParentControl = nil then Exit;
    if not (ParentControl is TForm) then Exit;

    R := BoundsRect;

    ID := false;
    if TForm(ParentControl).Icon.Handle <> 0 then
      IHandle := TForm(ParentControl).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;

  case FButtonState of
    bsNormal: inherited Draw(Canvas);
    bsHover: begin
      SaveBitmap := FBitmap;
      try
        if FBitmapHover.Assigned then
          FBitmap := FBitmapHover;
        inherited Draw(Canvas);
      finally
        FBitmap := SaveBitmap;
      end;
    end;
    bsDown: begin
      SaveBitmap := FBitmap;
      try
        if FBitmapDown.Assigned then
          FBitmap := FBitmapDown;
        inherited Draw(Canvas);
      finally
        FBitmap := SaveBitmap;
      end;
    end;
  end;
end;

procedure TSeSysButtonSkinObject.MouseHover;
begin
  if ssLeft in FShift then
    FButtonState := bsDown
  else
    FButtonState := bsHover;
  Invalidate;
end;

procedure TSeSysButtonSkinObject.MouseLeave;
begin
  FButtonState := bsNormal;
  Invalidate;
end;

procedure TSeSysButtonSkinObject.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 TSeSysButtonSkinObject.MouseDown(Button: TMouseButton; X,
  Y: integer);
begin
  if Button = mbLeft then
  begin
    FButtonState := bsDown;
    Invalidate;
  end;
end;

procedure TSeSysButtonSkinObject.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 ParentControl <> nil then
      Pos := ParentControl.ClientToScreen(Pos);
    {$IFDEF KS_COMPILER5_UP}
    Application.ActivateHint(Pos);
    {$ENDIF}
  end;

  FShift := Shift;
end;

procedure TSeSysButtonSkinObject.MouseUp(Button: TMouseButton; X,
  Y: integer);
begin
  if (FButtonState = bsDown) and (Button = mbLeft) then
  begin
    FButtonState := bsHover;
    Invalidate;

    DoAction;
  end;
  FShift := [];
end;

procedure TSeSysButtonSkinObject.SetAction(const Value: TSeAction);
begin
  FAction := Value;
end;

procedure TSeSysButtonSkinObject.SetBitmapDown(const Value: TSeBitmapLink);
begin
  FBitmapDown.Assign(Value);
end;

procedure TSeSysButtonSkinObject.SetBitmapHover(
  const Value: TSeBitmapLink);
begin
  FBitmapHover.Assign(Value);
end;

{ TSeActiveSkinObject =========================================================}

constructor TSeActiveSkinObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveFont := TFont.Create;
end;

destructor TSeActiveSkinObject.Destroy;
begin
  FActiveFont.Free;
  inherited Destroy;
end;

procedure TSeActiveSkinObject.Assign(Source: TPersistent);
begin
  if Source is TSeActiveSkinObject then
  begin
    inherited Assign(Source);
    ActiveColor := (Source as TSeActiveSkinObject).ActiveColor;
    ActiveFont := (Source as TSeActiveSkinObject).ActiveFont;
  end
  else
    inherited;
end;

procedure TSeActiveSkinObject.ChangeHue(DeltaHue: integer);
begin
  inherited;
  FActiveColor := KColorToColor(se_controls.ChangeHue(KColor(FActiveColor), DeltaHue));
  FActiveFont.Color := KColorToColor(se_controls.ChangeHue(KColor(FActiveFont.Color), DeltaHue));
end;

procedure TSeActiveSkinObject.Draw(Canvas: TCanvas);
var
  SaveColor: TColor;
  SaveFont: TFont;
begin
  if Width <= 0 then Exit;
  if Height <= 0 then Exit;
  
  if (State = ssFocused) or (State = ssHot) then
  begin
    SaveFont := Font;
    SaveColor := Color;
    try
      FColor := FActiveColor;
      FFont := FActiveFont;
      inherited Draw(Canvas);
    finally
      FFont := SaveFont;
      FColor := SaveColor;
    end;
  end
  else
    inherited Draw(Canvas);
end;

procedure TSeActiveSkinObject.MouseHover;
begin
  State := ssHot;
  Invalidate;
end;

procedure TSeActiveSkinObject.MouseLeave;
begin
  State := ssNormal;
  Invalidate;
end;

procedure TSeActiveSkinObject.SetActiveFont(const Value: TFont);
begin
  FActiveFont.Assign(Value);
end;

{ TSeColorButtonObject ========================================================}

constructor TSeColorButtonObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHotFont := TFont.Create;
  FPressedFont := TFont.Create;
  FDisabledFont := TFont.Create;
  FFocusedFont := TFont.Create;
end;

destructor TSeColorButtonObject.Destroy;
begin
  FFocusedFont.Free;
  FDisabledFont.Free;
  FPressedFont.Free;
  FHotFont.Free;
  inherited Destroy;
end;

procedure TSeColorButtonObject.Assign(Source: TPersistent);
begin
  if Source is TSeColorButtonObject then
  begin
    inherited Assign(Source);
    HotFont := (Source as TSeColorButtonObject).FHotFont;
    HotColor := (Source as TSeColorButtonObject).FHotColor;
    PressedFont := (Source as TSeColorButtonObject).FPressedFont;
    PressedColor := (Source as TSeColorButtonObject).FPressedColor;
    FocusedFont := (Source as TSeColorButtonObject).FFocusedFont;
    FocusedColor := (Source as TSeColorButtonObject).FFocusedColor;
    DisabledFont := (Source as TSeColorButtonObject).FDisabledFont;
    DisabledColor := (Source as TSeColorButtonObject).FDisabledColor;
  end
  else
    inherited;
end;

procedure TSeColorButtonObject.Draw(Canvas: TCanvas);
var
  SaveFont: TFont;
  SaveColor: TColor;
begin
  if Width <= 0 then Exit;
  if Height <= 0 then Exit;
  
  SaveFont := TFont.Create;
  try
    SaveFont.Assign(Font);
    SaveColor := Color;

    case State of
      ssHot: begin
        Font.Assign(FHotFont);
        Color := FHotColor;
      end;
      ssFocused: begin
        Font.Assign(FFocusedFont);
        Color := FFocusedColor;
      end;
      ssPressed: begin
        Font.Assign(FPressedFont);
        Color := FPressedColor;
      end;
      ssDisabled: begin
        Font.Assign(FDisabledFont);
        Color := FDisabledColor;
      end;
    end;
    inherited Draw(Canvas);
  finally
    Font.Assign(SaveFont);
    Color := SaveColor;

    SaveFont.Free;
  end;
end;

procedure TSeColorButtonObject.MouseHover;
begin
  inherited;
end;

procedure TSeColorButtonObject.MouseLeave;
begin
  inherited;
end;

procedure TSeColorButtonObject.SetDisabledColor(const Value: TColor);
begin
  FDisabledColor := Value;
end;

procedure TSeColorButtonObject.SetDisabledFont(const Value: TFont);
begin
  FDisabledFont.Assign(Value);
end;

procedure TSeColorButtonObject.SetFocusedColor(const Value: TColor);
begin
  FFocusedColor := Value;
end;

procedure TSeColorButtonObject.SetFocusedFont(const Value: TFont);
begin
  FFocusedFont.Assign(Value);
end;

procedure TSeColorButtonObject.SetHotColor(const Value: TColor);
begin
  FHotColor := Value;
end;