|
end;
else FRgn := CreateRectRgn(1 + n, 1 + n, Width - n - 1, Height - n - 1);
end;//case
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
end;
end;
procedure TDsFancyButton.WriteCaption;
var
Flags: Word;
BtnL, BtnT, BtnR, BtnB: Integer;
R, TR: TRect;
begin
R := ClientREct; TR := ClientRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Flags := DT_CENTER or DT_SINGLELINE;
Canvas.Font := Font;
if FIsDown then FTextColor := FrameColor
else FTextColor := Self.Font.Color;
with canvas do
begin
BtnT := (Height - TextHeight(Caption)) div 2;
BtnB := BtnT + TextHeight(Caption);
BtnL := (Width - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Caption);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R := TR;
if ((TextStyle = txLowered) and FIsDown ) or
((TextStyle = txRaised) and not FIsDown) then
begin
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end
else if ((TextStyle = txLowered) and not FIsDown) or
((TextStyle = txRaised) and FIsDown) then
begin
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end
else if (TextStyle = txShadowed) and FIsDown then
begin
Font.Color := clBtnShadow;
OffsetREct(TR, 3 + 1, 3 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end
else if (TextStyle = txShadowed) and not FIsDown then
begin
Font.Color := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags);
end;
if Enabled then Font.Color := FTextColor//self.Font.Color
else if (TextStyle = txShadowed) and not Enabled then
Font.Color := clBtnFace
else Font.Color := clBtnShadow;
if FIsDown then OffsetRect(R, 1, 1)
else OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Caption), Length(Caption), R, Flags);
end;
end;
procedure TDsFancyButton.SetButtonColor(value: TColor);
begin
if value <> FButtonColor then
begin FButtonColor := value ; Invalidate; end;
end;
procedure TDsFancyButton.WMLButtonDown(var message: TWMLButtonDown);
begin
if not PtInRegion(MRgn, message.xPos, message.yPos) then Exit;
FIsDown := True;
Paint;
inherited;
end;
procedure TDsFancyButton.WMLButtonUp(var message: TWMLButtonUp);
begin
if not FIsDown then Exit;
FIsDown := False;
paint;
inherited;
end;
procedure TDsFancyButton.SetShape(value: TShape);
begin
if value <> FShape then
begin FShape := value; Invalidate; end;
end;
procedure TDsFancyButton.SetTextStyle(value: TTextStyle);
begin
if value<>FTextStyle then
begin FTextStyle := value; Invalidate; end;
end;
procedure TDsFancyButton.SetFrameColor(value: TColor);
begin
if Value<>FFrameColor then
begin FFrameColor := Value; Invalidate;end;
end;
procedure TDsFancyButton.SetFrameWidth(Value: Integer);
var
w: integer;
begin
if Width<height then w := Width else w := Height;
if Value<>FFrameWidth then FFrameWidth := value;
if FFrameWidth < 4 then FFrameWidth := 4;
if FFrameWidth >(w div 2) then FFrameWidth := (w div 2);
Invalidate;
end;
procedure TDsFancyButton.SetCornerRadius(Value: integer);
var
w: integer;
begin
if Width<Height then w := Width else w := Height;
if value<>FCornerRadius then FCornerRadius := value;
if FCornerRadius<3 then FCornerRadius := 3;
if FCornerRadius>w then FCornerRadius := w;
Invalidate;
end;
procedure TDsFancyButton.CMEnabledChanged(var message: Tmessage);
begin
inherited;
invalidate;
end;
procedure TDsFancyButton.CMTextChanged(var message: TMessage);
begin
Invalidate;
end;
procedure TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
begin
With Message do
if IsAccel (CharCode, Caption) and Enabled then
begin Click; Result := 1 ;end
else inherited;
end;
procedure TDsFancyButton.WMSize(var Message: TWMSize);
begin
inherited;
if width>300 then width := 300;
if Height>300 then Height := 300;
end;
procedure TDsFancyButton.Click;
begin
FIsDown := False;
Invalidate;
inherited Click;
end;
procedure Register;
begin
RegisterComponents(''''WYM COMPONENT'''',[TDsFancyButton]);
end;
end.
上一页 [1] [2]
没有相关教程
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
