Текущий архив: 2004.07.18;
Скачать: CL | DM;

Вниз

Transparent в RadioButton   Найти похожие ветки 

← →
killer ©   (2004-07-03 23:07) [0]

Еще вопросик про transparent... Как его сделать в RadioButton-е?

---

← →
killer ©   (2004-07-04 00:11) [1]

Я нашел компонент TransparentRadioButton, но он почему то вызывается ошибка при установке его на форму... Вот его код(выложу в двух мессагах, т.к. ругается что сообщение очень длинное):

unit TRANSRAD;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
 TTransRadioButton = class(TCustomControl)
 private
   FDown:Boolean;
   FCheckedColor:TColor;
   FGroupIndex:Byte;
   FChecked: Boolean;
   procedure TurnSiblingsOff;
   function GetTransparent: Boolean;
   Procedure SetTransparent(Value: Boolean);
   procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
   procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
   procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
   procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
 protected
   procedure SetDown(Value:Boolean);
   procedure SetCheckedColor(Value:TColor);
   constructor Create(AOwner: TComponent); override;
   procedure SetChecked(Value: Boolean);
   procedure Paint; override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
     X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
     X, Y: Integer); override;
   procedure DoEnter; override;
   procedure DoExit; override;
   function  GetCaption: TCaption;
   procedure SetCaption(const Value:TCaption);
   procedure CreateWnd; override;

 public
   property canvas;
 published
   property Caption: TCaption read GetCaption write SetCaption;
   property CheckedOnColor:TColor read FCheckedColor write SetCheckedColor
            default clbtnShadow;
   property Checked: Boolean read FChecked write SetChecked default False;
   property Ctl3d;
   property Down:Boolean read FDown write SetDown default False;
   property DragCursor;
   property DragMode;
   property Enabled;
   property Font;
   property GroupIndex:Byte read FGroupIndex write FGroupIndex
     default 0;
   property ShowHint;
   property TabOrder;
   property TabStop;
   property Transparency: Boolean Read GetTransparent Write SetTransParent default True;
   property Visible;
   property OnClick;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDrag;
   property OnEnter;
   property OnExit;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
 end;

procedure Register;

implementation

const bw=12;

procedure Register;
begin
 RegisterComponents("Additional", [TTransRadioButton]);
end;

constructor TTransRadioButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 Width := 150;
 Height := 17;
end;

procedure TTransRadioButton.TurnSiblingsOff;
var i:Integer;
   Sibling: TTransRadioButton;
begin
    if Parent <> nil then
      for i:=0 to Parent.ControlCount-1 do
        if Parent.Controls[i] is TTransRadioButton then
          begin
            Sibling:=TTransRadioButton(Parent.Controls[i]);
            if (Sibling<>Self) and
               (Sibling.GroupIndex=GroupIndex) then
                 Sibling.SetChecked(False);
          end;
end;

function TTransRadioButton.GetTransparent: Boolean;
begin
 Result := not (csOpaque in ControlStyle);
end;

procedure TTransRadioButton.SetTransparent(Value: Boolean);
begin
 if Transparency <> Value then
 begin
   if Value then
     ControlStyle := ControlStyle - [csOpaque] else
     ControlStyle := ControlStyle + [csOpaque];
   Invalidate;
 end;
end;

procedure TTransRadioButton.Paint;
var
 H: Integer;
 R: TRect;
 C: array [Byte] of Char;
 CLen: Integer;
 BL,BT,BR,BB,BM:Integer;
   TX,TY,TW,TH:Integer;
   CX,CY:Integer;
   BRect:TRect;
begin
    Canvas.Font:=Font;
    with Canvas do
      begin
        BM:=12 div 2;
        BT:=(Height div 2)-BM;
        BB:=BT+12;
        BL:=1;
        BR:= 12+1;
        if not FDOWN then
          begin
            Pen.Color:= clbtnShadow;
            Arc(BL,BT,BR,BB,BR,BT,BL,BB);
            Pen.Color:= clbtnHighlight;
            Arc(BL,BT,BR,BB,BL,BB,BR,BT);
            Pen.Color:= clBlack;
            Brush.Color := clBtnFace;
            Ellipse(BL+2,Bt+2,BR-2,BB-2);
            end
        else
          begin
            if Checked then Pen.Color:= ClbtnShadow
                       else Pen.Color:= ClbtnHighlight;
            Arc(BL,BT,BR,BB,BR,BT,BL,BB);
            if Checked then Pen.Color:= ClbtnHighlight
                       else Pen.Color:= ClbtnShadow;
            Arc(BL,BT,BR,BB,BL,BB,BR,BT);
          end;
        if Checked then
           begin
             Pen.Color:= CheckedOnColor;
             Brush.Color := CheckedOnColor;
             Ellipse(BL+2,BT+2,BR-2,BB-2);
           end;
           Brush.Color := clBtnFace;
        TX:=BR+5;
        TY:=(Height div 2)+(Font.Height div 2)-1;
        if Transparency then
        begin
        SetBkMode(Handle,TRANSPARENT);
        SetBkColor(Handle,Font.Color);
        end;
        SetTextColor(Handle,Font.Color);
        TW:=TextWidth(Caption);
        TH:=TextHeight(Caption);
        TextOut(TX,TY,Caption);
        BRect:=Bounds(TX-1,TY,TW+3,TH+1);
        DrawText(Handle, C, CLen, R, DT_LEFT or DT_SINGLELINE);
    end;
end;

procedure TTransRadioButton.SetDown(Value:Boolean);
begin
    if FDown<>Value then
      begin
        FDown:=Value;
        Paint;
      end;
end;

procedure TTransRadioButton.DoEnter;
begin
    inherited DoEnter;
    Checked:=True;
    Paint;
end;

procedure TTransRadioButton.DoExit;
begin
    inherited DoExit;
    Checked := False;
    Paint;
end;

procedure TTransRadioButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
                                 X, Y: Integer);
begin
    inherited MouseDown(Button, Shift, X, Y);
    Down:=True;
end;


---

← →
killer ©   (2004-07-04 00:12) [2]


procedure TTransRadioButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
                                 X, Y: Integer);
begin
    Down:=False;
    if (X>=0) and (X<=Width) and (Y>=0) and (Y<=Height)
      and not Checked then Checked:=True;
    inherited MouseUp(Button, Shift, X, Y);
end;

function TTransRadioButton.GetCaption:TCaption;
var
 Buffer: PChar;
 Size: Byte;
begin
 Size := GetTextLen;             {Get length of string in Caption}
 Inc(Size);                      {Add room for null character}
 GetMem(Buffer, Size);           {Creates Buffer dynamic variable}
 GetTextBuf(Buffer,Size);        {Puts Caption into Buffer}
 Result := StrPas(Buffer);       {Converts Buffer to a Pascal-style string}
 FreeMem(Buffer, Size);          {Frees memory allocated to Buffer}
End;

procedure TTransRadioButton.SetCaption(const Value:TCaption);
var Buffer: array[0..255] of Char;
begin
    if GetCaption <> Value then
      SetTextBuf(StrPCopy(Buffer,Value));
    Invalidate;
end;

procedure TTransRadioButton.SetChecked(Value: Boolean);
begin
    if FChecked <> Value then
      begin
        TabStop:=Value;
        FChecked:=Value;
        if Value then
          begin
            TurnSiblingsOff;
            Click;
          end;
        Paint;
      end;
end;

procedure TTransRadioButton.SetCheckedColor(Value:TColor);
begin
    FCheckedColor:=Value;
    Paint;
end;

procedure TTransRadioButton.CreateWnd;
begin
 inherited CreateWnd;
 SendMessage(Handle, BM_SETCHECK, Cardinal(FChecked), 0);
 if Ctl3D and (Ctl3DBtnWndProc <> nil) then
   DefWndProc := Ctl3DBtnWndProc;
end;

procedure TTransRadioButton.WMSetFocus(var Message: TWMSetFocus);
begin
 if Ctl3D and (Ctl3DBtnWndProc <> nil) then UpdateWindow(Handle);
 inherited;
end;

procedure TTransRadioButton.CMCtl3DChanged(var Message: TMessage);
begin
 RecreateWnd;
end;

procedure TTransRadioButton.CMDialogChar(var Message: TCMDialogChar);
begin
 with Message do
   if IsAccel(Message.CharCode, Caption) and CanFocus then
   begin
     SetFocus;
     Result := 1;
   end else
     inherited;
end;

procedure TTransRadioButton.CNCommand(var Message: TWMCommand);
begin
 case Message.NotifyCode of
   BN_CLICKED: SetChecked(True);
   BN_DOUBLECLICKED: DblClick;
 end;
end;
end.


---

Страницы: 1 вся ветка

Текущий архив: 2004.07.18;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.023 c