VPF::прозрачний текст - Форум программистов

Stalker Ghost

Дата 9.11.2004, 18:12 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Как создать можно кнопку, у какой при ненажатом состоянии, но с наведённым маусом отображалось то что снизу, под ней, TImage например и края (обычний прямоугольник). То есть чтобы была прозрачной.
smile

В нажатом сотоянии отображает тот же прямоугольник залитый цветом fPressedColor

Код


   if fMouseDown then
     begin
      fBtnColor:=fPressedColor;
      Canvas.Brush.Color:=fBtnColor;
      Canvas.FillRect(Rect(1,1,Width - 1,Height - 1));
     end;

//else ???????????


 If fMouseOver then  
  Begin
   Canvas.MoveTo(Width,0);  
   Canvas.Pen.Color := clBlack;  
   Canvas.LineTo(0,0);  
   Canvas.LineTo(0,Height - 1);  
   Canvas.LineTo(Width - 1,Height - 1);  
   Canvas.LineTo(Width - 1, - 1);  
  End;

Компонент это сын TCustomControl.

Stalker Ghost

Дата 10.11.2004, 01:07 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Простите, я ошибся когда написал в теме "прoзрачний текст". Это "прозрачний фон" или "прозрачная кнопка"

p0s0l

Дата 10.11.2004, 14:25 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 16
Всего: 112

А если кнопка не нажата, и мышка не над кнопкой ?
Почему нельзя просто выводить на Button какой-то Image, когда мышь над кнопкой ? Зачем под неё что-то прятать ?...

--------------------

С уважением, г-н Посол.

Stalker Ghost

Дата 10.11.2004, 18:02 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Image под кнопкой это отдельний елемент, это фон растянутый на всю форму, размеры кнопки меньше, чем битмап.
В ненажатом состоянии, с мышью или без, кнопка рисуется цветом форми. Вот это-го я и не хочу. Как можно "не рисовать" этот цвет, есть ли какой номер для прозрачного цвета?

p0s0l

Дата 10.11.2004, 21:27 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 16
Всего: 112

На скорую руку вот что получилось (только наследовалась от TButton)

Код

type
  TMyButton = class (TButton)
  protected
    procedure Paint (var msg : TMessage); message WM_PAINT;
  public
    PressedColor : TColor;
  end;

procedure TMyButton.Paint;
var
  IsMouseOver, IsPressed : boolean;
  R, R1, R2 : TRect;
  Pt : TPoint;
  Canvas : TCanvas;
  Bmp : TBitmap;
  x, y : integer;

begin
  inherited;

  IsMouseOver := PtInRect (ClientRect, ScreenToClient(Mouse.CursorPos));
  IsPressed := (SendMessage (Handle, BM_GETSTATE, 0, 0) and BST_PUSHED) <> 0;

  Canvas := TCanvas.Create;
  Canvas.Handle := GetDC(Handle);

  R := Rect (2, 2, ClientWidth-2, ClientHeight-2);
  if IsMouseOver and (not IsPressed) then
  begin
    R1 := R;
    OffsetRect (R1, -1, -1);
    R2 := R1;
    Pt := ClientToParent(Point(R.Left, R.Top));
    OffsetRect (R2, Pt.X-R.Left, Pt.Y-R.Top);

    Bmp := TBitmap.Create;
    Bmp.Width := Parent.ClientWidth;
    Bmp.Height := Parent.ClientHeight;
    SendMessage (Parent.Handle, WM_PRINTCLIENT, Bmp.Canvas.Handle, PRF_CLIENT);
    Canvas.CopyMode := SRCCOPY;
    Canvas.CopyRect(R1, Bmp.Canvas, R2);
    Bmp.Free;
  end;

  if IsPressed then
  begin
    Canvas.Brush.Color := PressedColor;
    Canvas.FillRect(R);
  end;

  if IsPressed or IsMouseOver then
  begin
    Canvas.Font := Font;
    Canvas.Brush.Style := bsClear;
    x := (ClientWidth - Canvas.TextWidth(Caption)) div 2;
    y := ((ClientHeight - Canvas.TextHeight(Caption)) div 2) - 1;

    if IsPressed then
    begin
      Inc(x);
      Inc(y);
    end;

    Canvas.TextRect(R, x, y, Caption);
  end;
  ReleaseDC (Handle, Canvas.Handle);
  Canvas.Free;

end;

Пример создания:

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  b : TMyButton;

begin
  b:=TMyButton.Create(nil);
  b.Caption := 'Test Button';
  b.PressedColor := clGreen;
  b.Left := 100;
  b.Top := 100;
  b.Parent := Self;
end;

Примечание: немного по-корявому, т.к. рисуется в невидимый битмап Parent кнопки. А потом это рисуется на кнопке...
Если под твоей кнопкой есть, например, TEdit или TButton, то будет неправильно - TMyButton будет просвечивать сквозь них до самой формы... Но TImage будет отображаться нормально...

--------------------

С уважением, г-н Посол.

Stalker Ghost

Дата 11.11.2004, 01:08 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Спасибо большое!! smile

Я тоже попробовал наследовать от TSpeedButton, при Transparent=true, получается ефект прозрачности.
Если кого-то интересует:

Код


unit LittleButton;

interface

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

Const fShift = 1;

type                                         
  TLittleButton = class(TSpeedButton)
  private
    { Private declarations }
   fMouseOver,fMouseDown             : Boolean;
   fEnabled                          : Boolean;
   fTextTop,fTextLeft                : Integer;
   fCaption                          : String;
   fOverColor                        : TColor; //Mouse-over color
   fStartGradientColor               : TColor;
   fEndGradientColor                 : TColor;
   Procedure fSetCaption(S : String);
   Procedure fSetTextTop(I : Integer);
   Procedure fSetTextLeft(I : Integer);
   Procedure fSetEnabled(B : Boolean);
   Procedure fSetOverColor(C : TColor);
   Procedure fSetStartGradientColor(C : TColor);
   Procedure fSetEndGradientColor(C : TColor);

  protected
    { Protected declarations }
   Procedure Paint; override;  
   Procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
   Procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;  
   Procedure WndProc(var Message : TMessage); override;

  public
    { Public declarations }
   constructor Create (AOwner: TComponent); override;
   destructor Destroy; override;
    
  published
    { Published declarations }
   Property Action;  
   Property Anchors;
   Property BiDiMode;
   Property Caption : String
       read fCaption write fSetCaption;
   Property Constraints;
   Property Cursor;
   Property Enabled : Boolean
       read fEnabled write fSetEnabled;
   Property EndGradientColor : TColor
       read fEndGradientColor write fSetEndGradientColor;
   Property Font;
   Property Height;
   Property Hint;
   Property Left;
   Property Name;
   Property ParentFont;
   Property ParentShowHint;
   Property OverColor : TColor
       read fOverColor write fSetOverColor;
   Property ShowHint;
   Property StartGradientColor : TColor
       read fStartGradientColor write fSetStartGradientColor;
   Property Tag;
   Property Textleft : Integer
       read fTextLeft write fSetTextLeft;  
   Property TextTop : Integer
       read fTextTop write fSetTextTop;
   Property Top;
   Property Transparent;
   Property Visible;
   Property Width;
    {--- Events ---}
   Property OnClick;
   Property OnDblClick;
   Property OnMouseDown;
   Property OnMouseMove;
   Property OnMouseUp;
  end;

procedure Register;

implementation


procedure TLittleButton.fSetEnabled(B : Boolean);
begin
 if B<>fEnabled then
   begin
    fEnabled := B;
    Invalidate;
   end;
end;

procedure TLittleButton.fSetOverColor(C : TColor);
begin
 if C<>fOverColor then
   begin
    fOverColor:=C;
    Invalidate;
   end;
end;

procedure TLittleButton.fSetStartGradientColor(C : TColor);
begin
 if C<>fStartGradientColor then
   begin
    fStartGradientColor:=C;
    Invalidate;
   end;
end;

procedure TLittleButton.fSetEndGradientColor(C : TColor);
Begin
 if C<>fEndGradientColor then
   begin
    fEndGradientColor:=C;
    Invalidate;
   end;
end;

procedure TLittleButton.fSetTextTop(I : Integer);
begin
 if I>=0 then
  if I<>fTextTop then
    begin
     fTextTop := I;
     Invalidate;
    end;
end;

procedure TLittleButton.fSetTextLeft(I : Integer);
begin
 if I>=0 then
  if I<>fTextLeft then
    begin
     fTextLeft:=I;
     Invalidate;
    end;
end;

procedure TLittleButton.fSetCaption(S : String);
begin
 if fCaption<>S then
   begin
    fCaption := S;
    SetTextBuf(PChar(S));
    Invalidate;
   end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TLittleButton]);
end;

constructor TLittleButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 Height := 30;
 Width := 70;
 fMouseOver := False;
 fMouseDown := False;
 fTextLeft := 2;
 fTextTop := 2;      
 fEnabled := True;
 fOverColor:=$009AD5FF;
 fStartGradientColor:=$003091FE;
 fEndGradientColor:=$008ED3FF;
end;

destructor TLittleButton.Destroy;
begin
 inherited Destroy;
end;

procedure TLittleButton.Paint;
var Buffer          : Array[0..127] of Char;
    i               : Integer;
    Rs,Gs,Bs        : Byte;    //Start color
    Re,Ge,Be        : Byte;    //End color
begin
 //Colors of Start
 Rs:=GetRValue(fStartGradientColor);
 Gs:=GetGValue(fStartGradientColor);
 Bs:=GetBValue(fStartGradientColor);
 //Colors of End
 Re:=GetRValue(fEndGradientColor);
 Ge:=GetGValue(fEndGradientColor);
 Be:=GetBValue(fEndGradientColor);

 GetTextBuf(Buffer,SizeOf(Buffer));
 if Buffer <> '' then fCaption := Buffer;
 if fEnabled = False then fMouseDown := False;
                                
 if fMouseOver then
   begin
    Canvas.MoveTo(Width,0);
    Canvas.Pen.Color := clBlack;
    Canvas.LineTo(0,0);
    Canvas.LineTo(0,Height - 1);
    Canvas.LineTo(Width - 1,Height - 1);
    Canvas.LineTo(Width - 1, - 1);
    Canvas.Brush.Color:=fOverColor;
    Canvas.FillRect(Rect(1,1,Width - 1,Height - 1));
   end;

  if fMouseDown and fMouseOver then
    begin
     for i:=1 to Height-2 do
      begin
       Canvas.Pen.Color:=RGB(Round(Rs-(Rs-Re)/Height*i),
                             Round(Gs-(Gs-Ge)/Height*i),
                             Round(Bs-(Bs-Be)/Height*i));
       Canvas.MoveTo(1,i);
       Canvas.LineTo(Width-1,i);
      end;
    end;

 if fCaption <> '' then
   begin
    Canvas.Pen.Color := Font.Color;
    Canvas.Font.Name := Font.Name;
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Color := Font.Color;
    Canvas.Font.Size := Font.Size;
    Canvas.Font.Style := Font.Style;
    if fMouseDown then Canvas.TextOut(fShift + fTextLeft,fShift + fTextTop,fCaption)
                  else Canvas.TextOut(fTextLeft,fTextTop,fCaption);
   end;

end;

procedure TLittleButton.MouseDown(Button: TMouseButton;
   Shift: TShiftState;X, Y: Integer);  
var ffMouseDown, ffMouseOver : Boolean;
begin
 ffMouseDown:=True;
 ffMouseOver:=True;
 if (ffMouseDown<>fMouseDown)or(ffMouseOver<>fMouseOver) then
   begin
    fMouseDown:=ffMouseDown;
    fMouseOver:=ffMouseOver;
    Invalidate;
   end;
 inherited MouseDown(Button,Shift,X,Y);;
end;

procedure TLittleButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
var ffMouseDown, ffMouseOver : Boolean;
begin
 ffMouseDown:=False;
 ffMouseOver:=True;
 if (ffMouseDown<>fMouseDown)or(ffMouseOver<>fMouseOver) then
   begin
    fMouseDown:=ffMouseDown;
    fMouseOver:=ffMouseOver;
    Invalidate;
   end;
 inherited MouseUp(Button,Shift,X,Y);
end;

procedure TLittleButton.WndProc(var Message : TMessage);
var P1,P2 : TPoint;
           Bo : Boolean;
begin
 if Parent<>nil then
   begin
    GetCursorPos(P1);
    P2 := Self.ScreenToClient(P1);
    if (P2.X > 0) and (P2.X < Width) and
       (P2.Y > 0) and (P2.Y < Height) then Bo:=True // In region
                                                       else Bo:=False; // Out of Region
    if Bo<>fMouseOver then
      begin
       fMouseOver:=Bo;
       Invalidate;
      end;
    end;
inherited WndProc(Message);
end;

end.

Я знаю, что многие с этого форума напишут это лучше, но не судите меня - с Делфи я всерёз работаю только месяц. smile

Простите, что побеспокоил. smile

p0s0l

Дата 12.11.2004, 18:11 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 16
Всего: 112

Во блин, совсем наоборот надо было сделать smile

Когда мышь не над кнопкой - должна просвечать...

Цитата

Я знаю, что многие с этого форума напишут это лучше, но не судите меня - с Делфи я всерёз работаю только месяц.

Если ты через месяц пишешь компоненты - то ты обгоняешь в изучении Delphi многих форумистов smile

--------------------

С уважением, г-н Посол.

Stalker Ghost

Дата 13.11.2004, 00:03 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 41
Регистрация: 11.11.2004
Где: между столом и ст улом

Репутация: 1
Всего: 2

Цитата(p0s0l @ 12.11.2004, 18:11)

Во блин, совсем наоборот надо было сделать
Когда мышь не над кнопкой - должна просвечать...

Я заливку fStartGradientColor - fEndGradientColor и цвет fOverColor потом уже доделал, после твоей помощи.

Цитата(p0s0l @ 12.11.2004, 18:11)

Если ты через месяц пишешь компоненты - то ты обгоняешь в изучении Delphi многих форумистов

Спасибо! Делфи это так, хобби. Я на медицинском факультете вообще-то smile

Это сообщение отредактировал(а) Stalker Ghost - 13.11.2004, 00:11

AndreiBes

Дата 19.11.2004, 14:12 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 15
Регистрация: 2.11.2004

Репутация: нет
Всего: -2

Попробуй так:
Image.Picture.BitMap.TransParentColor:= цвет который ты хочешь чтоб был прозрачным

Stalker Ghost

Дата 19.11.2004, 19:31 (ссылка)

(нет голосов)

Загрузка ...

Bitmap под кнопкой а не над ней. Да и проблема уже решена

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »