scustomlabel.pas

AlphaControls是一个Delphi标准控件的集合

procedure TsCustomLabel.AdjustBounds;
const
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
  AAlignment: TAlignment;
begin
  if not Assigned(Parent) then Exit;
  if not (csReading in ComponentState) and FAutoSize then begin
    Rect := ClientRect;
    DC := GetDC(0);
    Canvas.Handle := DC;
    DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
    Canvas.Handle := 0;
    ReleaseDC(0, DC);
    X := Left;
    AAlignment := FAlignment;
    if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
    if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
  SendToBack;
end;

procedure TsCustomLabel.SetAlignment(Value: TAlignment);
begin
  if not Assigned(Parent) then Exit;
  if FAlignment <> Value then begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TsCustomLabel.SetAutoSize(Value: Boolean);
begin
  if not Assigned(Parent) then Exit;
  if FAutoSize <> Value then begin
    FAutoSize := Value;
    AdjustBounds;
  end;
end;

procedure TsCustomLabel.SetFocusControl(Value: TWinControl);
begin
  if not Assigned(Parent) then Exit;
  FFocusControl := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TsCustomLabel.SetShowAccelChar(Value: Boolean);
begin
  if not Assigned(Parent) then Exit;
  if FShowAccelChar <> Value then begin
    FShowAccelChar := Value;
    Invalidate;
  end;
end;

procedure TsCustomLabel.SetLayout(Value: TTextLayout);
begin
  if not Assigned(Parent) then Exit;
  if FLayout <> Value then begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TsCustomLabel.SetWordWrap(Value: Boolean);
begin
  if not Assigned(Parent) then Exit;
  if FWordWrap <> Value then begin
    FWordWrap := Value;
    AdjustBounds;
    Invalidate;
  end;
end;

procedure TsCustomLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if not Assigned(Parent) then Exit;
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FFocusControl) then
    FFocusControl := nil;
end;

procedure TsCustomLabel.CMTextChanged(var Message: TMessage);
begin
  if not Assigned(Parent) then Exit;
  Invalidate;
  AdjustBounds;
end;

procedure TsCustomLabel.CMFontChanged(var Message: TMessage);
begin
  if not Assigned(Parent) then Exit;
  inherited;
  AdjustBounds;
end;


procedure TsCustomLabel.CMDialogChar(var Message: TCMDialogChar);
begin
  if not Assigned(Parent) then Exit;
  if (FFocusControl <> nil) and Enabled and ShowAccelChar and IsAccel(Message.CharCode, Caption) then begin
    with FFocusControl do begin
      if CanFocus then begin
        SetFocus;
        Message.Result := 1;
      end;
    end;
  end;
end;

procedure TsCustomLabel.WMNclButtonDown(var Message: TMessage);
begin
  if (FFocusControl <> nil) and Enabled and ShowAccelChar then begin
    with FFocusControl do begin
      if CanFocus then begin
        SetFocus;
//        Message.Result := 1;
      end;
    end;
  end;
  inherited;
end;

destructor TsCustomLabel.Destroy;
begin
  inherited Destroy;
end;

function TsCustomLabel.GetCurrentFont: TFont;
begin
  Result := nil;
  if not Assigned(Parent) then Exit;
  Result := Font;
end;

procedure TsCustomLabel.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  MouseAbove := True;
  Repaint;
end;

procedure TsCustomLabel.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  MouseAbove := False;
  Repaint;
end;

procedure TsCustomLabel.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

function TsCustomLabel.GetParentCache: TCacheInfo;
begin
  Result.Ready := False;
  Result.Bmp := nil;
  Result.X := 0;
  Result.Y := 0;
{$IFNDEF ALITE}
  if Parent is TsTabSheet then begin
    Result.Bmp := TsTabSheet(Parent).PageControl.CommonData.FCacheBmp;
    Result.X := TsTabSheet(Parent).PageControl.PageRect.Left;
    Result.Y := TsTabSheet(Parent).PageControl.PageRect.Top;
    Result.Ready := True;
  end
  else
{$ENDIF}  
{  if Parent is TCustomForm then begin
    ci.Msg := SM_GETSSTYLE;
    ci.Result := SendMessage(Parent.Handle, ci.Msg, 0, 0);
    if ci.Result > 0 then begin
//      ShowMessage(IntToStr(_TempBitmap.Width));
      Result.Ready := True;
      Result.Bmp := _TempBitmap;
      Result.X := _TempPoint.x;
      Result.Y := _TempPoint.y;
    end;
  end
  else}
  begin
    GlobalCacheInfo.Ready := False;
    SendMessage(Parent.Handle, SM_GETCACHE, 0, 0);
    Result := GlobalCacheInfo;
{
    s := GetsStyle(Parent);
    if (s <> nil) then begin
      Result.Bmp := s.FCacheBmp;
      Result.Ready := True;
    end;
}    
  end;
end;

procedure TsCustomLabel.SetTransparent(const Value: Boolean);
begin
  if not Assigned(Parent) then Exit;
  if FTransparent <> Value then begin
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TsCustomLabel.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Repaint;
end;

{ TsWebLabel }

constructor TsWebLabel.Create(AOwner: TComponent);
begin
  inherited;
  FShowMode := soDefault;
  Font.Color := clBlue;
  Font.Style := [fsUnderline];

  FHoverFont := TFont.Create;
  FHoverFont.Assign(Font);
  FHoverFont.Color := clRed;
  Cursor := crHandPoint;
end;

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

function TsWebLabel.GetCurrentFont: TFont;
begin
  if MouseAbove then begin
//    Self.Cursor := FHoverCursor;
    Result := FHoverFont
  end
  else begin
//    Self.Cursor := crDefault;
    Result := Font;
  end
end;

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

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

{ TsEditLabel }

procedure TsEditLabel.AdjustBounds;
begin
  inherited AdjustBounds;
{
  if Owner is TCustomLabeledEdit then
    with Owner as TCustomLabeledEdit do
      SetLabelPosition(LabelPosition);
}
end;

constructor TsEditLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Name := 'EditLabel';
//  SetSubComponent(True);
  FTransparent := True;
  if Assigned(AOwner) then
    Caption := AOwner.Name;
end;

function TsEditLabel.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TsEditLabel.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TsEditLabel.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TsEditLabel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TsEditLabel.SetHeight(const Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TsEditLabel.SetWidth(const Value: Integer);
begin
  SetBounds(Left, Top, Value, Height);
end;

end.