slabel.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

begin
  Result := TntControl_IsCaptionStored(Self)
end;

procedure TsCustomLabel.SetCaption(const Value: TWideCaption);
begin
  TntControl_SetText(Self, Value);
end;

function TsCustomLabel.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

function TsCustomLabel.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self)
end;

procedure TsCustomLabel.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TsCustomLabel.CMDialogChar(var Message: TCMDialogChar);
begin
  TntLabel_CMDialogChar(Self, Message, Caption);
end;

procedure TsCustomLabel.CMHintShow(var Message: TMessage);
begin
  ProcessCMHintShowMsg(Message);
  inherited;
end;

function TsCustomLabel.GetLabelText: WideString;
begin
  Result := Caption;
end;

{$ENDIF}

procedure TsCustomLabel.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  f : TFont;
  si : integer;
begin
  if not FontChanging then begin
    FontChanging := True;
    f := GetCurrentFont;
    if inherited Font <> f then inherited Font.Assign(f);
    if (SkinSection <> '') and (DefaultManager <> nil) and DefaultManager.Active then begin
      si := DefaultManager.GetSkinIndex(SkinSection);
      if (si > 0) and (Font.Color <> DefaultManager.gd[si].FontColor[1]) then begin
        Font.Color := DefaultManager.gd[si].FontColor[1]; // 5.40
      end;
    end;
    FontChanging := False;
  end;
  if (SkinSection <> '') and (DefaultManager <> nil) and DefaultManager.Active then begin
    si := DefaultManager.GetSkinIndex(SkinSection);
    if si > 0 then begin
      GetParentCache(Self);
      PaintItem(si, SkinSection, GlobalCacheInfo, True, 0, Rect(0, 0, Width, Height), Point(Left, Top), Canvas.Handle);
    end;
  end;
  inherited Paint
end;

procedure TsCustomLabel.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CM_FONTCHANGED : begin
      if not FontChanging then begin // v4.34
        if AutoSize then AdjustBounds;
        Repaint; // v4.50
      end;
      Exit
    end;
    CM_MOUSEENTER : if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  end;
{
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_ENDPARENTUPDATE : begin
      Repaint
    end;
  end;
}
  inherited;
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
{
    AC_SETNEWSKIN : Updated := False; // v4.34
    AC_REFRESH : if not Updated then begin
      Updated := True;
      Repaint; // v4.34
    end;
}
    AC_REMOVESKIN : if (Message.LParam = LongInt(DefaultManager)) and (Font.Color <> clWindowText) then Font.Color := clWindowText;
  end
  else case Message.Msg of
    CM_MOUSELEAVE : if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  end;
end;

procedure TsCustomLabel.SetSkinSection(const Value: string);
begin
  if FSkinSection <> Value then begin
    FSkinSection := Value;
    Repaint;
  end;
end;

{ TsWebLabel }

procedure TsWebLabel.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  MouseAbove := True;
  if AutoSize then begin
    Invalidate;
    Update;
    AdjustBounds;
  end;
  RePaint;
end;

procedure TsWebLabel.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  MouseAbove := False;
  if AutoSize then begin
    Invalidate;
    Update;
    AdjustBounds;
  end;
  RePaint;
end;

constructor TsWebLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowMode := soDefault;

  FHoverFont := TFont.Create;
  FNormalFont := TFont.Create;
  Cursor := crHandPoint;
  ControlStyle := ControlStyle + [csOpaque];
  Transparent := True;
end;

destructor TsWebLabel.Destroy;
begin
  if Assigned(FHoverFont) then FreeAndNil(FHoverFont);
  if Assigned(FNormalFont) then FreeAndNil(FNormalFont);
  inherited Destroy;
end;

function TsWebLabel.GetCurrentFont: TFont;
begin
  if MouseAbove then Result := FHoverFont else Result := FNormalFont;
end;

procedure TsWebLabel.Loaded;
begin
  inherited Loaded;
  inherited Font.Assign(FNormalFont); // v4.41
end;

procedure TsWebLabel.SetHoverFont(const Value: TFont);
begin
  FHoverFont.Assign(Value);
end;

procedure TsWebLabel.SetNormalFont(const Value: TFont);
begin
  inherited Font.Assign(Value); // v4.41
  FNormalFont.Assign(Value);
  Paint;
end;

procedure TsWebLabel.WMEraseBkGnd(var Message: TWMLButtonDown);
begin
end;

procedure TsWebLabel.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  if FURL <> '' then ShellExecute(Application.Handle, 'open', PChar(FURL), nil, nil, ord(FShowMode));
end;

{ TsEditLabel }

destructor TsEditLabel.Destroy;
begin
  TsBoundLabel(BoundLabel).FActive := False;
  inherited Destroy;
end;

constructor TsEditLabel.InternalCreate(AOwner: TComponent; BoundStruct: TObject);
begin
  inherited Create(AOwner);
  BoundLabel := BoundStruct;
end;

{ TsStickyLabel }

procedure TsStickyLabel.Adjust(MoveLabel: boolean);
var
  iNewTop, iNewLeft : Integer;
  MoveRelativeTo : TControl;
  Mover : TControl;
  Alignment : TAlignTo;
begin
  FRealigning := True;
  if FAttachTo <> nil then begin
    if MoveLabel then begin
      MoveRelativeTo := FAttachTo;
      Mover := Self;
      Alignment := FAlignTo;
    end
    else begin
      MoveRelativeTo := Self;
      Mover := FAttachTo;
      Alignment := altRight;
      case FAlignTo of
        altTop:    Alignment := altBottom;
        altRight:  Alignment := altLeft;
        altBottom: Alignment := altTop;
      end;
    end;

    Case Alignment of
       altLeft : begin
         iNewTop :=  MoveRelativeTo.Top + (MoveRelativeTo.Height - Mover.Height) div 2;
         iNewLeft := MoveRelativeTo.Left - Mover.Width - FGap;
       end;
       altRight : begin
         iNewTop :=  MoveRelativeTo.Top + (MoveRelativeTo.Height - Mover.Height) div 2;
         iNewLeft := MoveRelativeTo.Left + MoveRelativeTo.Width + FGap;
       end;
       altTop: begin
         iNewTop := MoveRelativeTo.Top - Mover.Height - FGap;
         iNewLeft := MoveRelativeTo.Left;
       end;
       else {alBottom:} begin
         iNewTop := MoveRelativeTo.Top + MoveRelativeTo.Height + FGap;
         iNewLeft := MoveRelativeTo.Left;
       end;
    end;
    { Set all propertied in one call to avoid multiple re-drawing & pos changes }
    Mover.SetBounds(iNewLeft, iNewTop, Mover.Width, Mover.Height);
  end;
  FRealigning := False;
end;

constructor TsStickyLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGap := 2;
  FRealigning := False;
end;

destructor TsStickyLabel.Destroy;
begin
  SetAttachTo(nil);
  inherited Destroy;
end;

procedure TsStickyLabel.NewWinProc(var Message: TMessage);
begin
  if not (csDestroying in ComponentState) then begin
    if Assigned(FAttachTo) and (not FRealigning) then begin
      FRealigning := True;
      try
        case(Message.Msg) of
          CM_ENABLEDCHANGED : Enabled := FAttachTo.Enabled;
          CM_VISIBLECHANGED : Visible := FAttachTo.Visible;
          WM_SIZE, WM_MOVE, WM_WINDOWPOSCHANGED : Adjust(Message.Msg <> WM_SIZE);
        end;
      finally
        FRealigning := FALSE;
      end;
    end;
  end;
  if Assigned(FOldWinProc) then FOldWinProc(Message);
end;

procedure TsStickyLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FAttachTo) then SetAttachTo(nil);
  inherited Notification(AComponent, Operation);
end;

procedure TsStickyLabel.SetAlignTo(Value: TAlignTo);
begin
  if (FAlignTo <> Value) then begin
    FAlignTo := Value;
    Adjust(True);
  end;
end;

procedure TsStickyLabel.SetAttachTo(Value: TWinControl);
begin
  if(Value <> FAttachTo) then begin
    if (Assigned(FAttachTo)) then FAttachTo.WindowProc := FOldWinProc;
    FAttachTo := Value;
    if (Assigned(Value)) then begin
      Adjust(True);
      Enabled := FAttachTo.Enabled;
      Visible := FAttachTo.Visible;
      FOldWinProc := FAttachTo.WindowProc;
      FAttachTo.WindowProc := NewWinProc;
    end;
  end;
end;

procedure TsStickyLabel.SetGap(Value: Integer);
begin
  if (FGap <> Value) then begin
    FGap := Value;
    Adjust(True);
  end;
end;

procedure TsStickyLabel.WndProc(var Message: TMessage);
begin
  if not (csDestroying in ComponentState) and Assigned(FAttachTo) and not FRealigning then begin
    FRealigning := True;
    try
      if Message.Msg = WM_WINDOWPOSCHANGED then Adjust(False);
   finally
      FRealigning := False;
    end;
  end;
  inherited WndProc(Message);
end;

{ TsShadow }

constructor TsShadow.Create(AOwner: TComponent; Control : TControl);
begin
  FColor := clBlack;
  FBlurCount := 4;
  FDistance := 1;
  FMode := smSkin1;
  ParentControl := Control;
end;

destructor TsShadow.Destroy;
begin
  inherited;
end;

procedure TsShadow.SetBlurCount(const Value: Integer);
begin
  if FBlurCount <> Value then begin