Реализация тени

Тема в разделе "Delphi - Система", создана пользователем Herp, 21 апр 2006.

Статус темы:
Закрыта.
  1. Herp

    Herp Гость

    Всем привет!

    Народ может кто знает, как реализуется такая тень, которая у меня в аттаче

    Программирую
    на Delphi 5.
     

    Вложения:

    • 1.jpg
      1.jpg
      Размер файла:
      3,9 КБ
      Просмотров:
      127
  2. Alex Death

    Alex Death Гость

    <!--QuoteBegin-Herp+21:04:2006, 13:29 -->
    <span class="vbquote">(Herp @ 21:04:2006, 13:29 )</span><!--QuoteEBegin-->Всем привет!

    Народ может кто знает, как реализуется такая тень, которая у меня в аттаче

    Программирую
    на Delphi 5.
    [snapback]34165" rel="nofollow" target="_blank[/snapback]​
    [/quote]
    Сначала всю область через пиксел (в шахматном порядке) рисуешь цветом (0,0,0), со смещением. А потом уже и хинт прорисовываешь..
     
  3. Herp

    Herp Гость

    Alex Death, а можно пример?
     
  4. mike.dld

    mike.dld Гость

    Пример за 10 минут:
    Код (Text):
    unit Unit1;

    interface

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

    type
    TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    TMyHintWindowClass = class(THintWindow)
    protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    public
    constructor Create(AOwner: TComponent); override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
    AData: Pointer): TRect; override;
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    HintWindowClass := TMyHintWindowClass;
    end;

    { TMyHintWindowClass }

    procedure TMyHintWindowClass.ActivateHint(Rect: TRect;
    const AHint: string);
    const
    shadow_size = 4;
    var
    r1,r2: HRGN;
    i,j: integer;
    begin
    inherited ActivateHint(Rect,AHint);
    r1 := CreateRectRgn(0,0,width-1,height-1);
    r2 := CreateRectRgn(width-shadow_size-1,0,width-1,shadow_size);
    CombineRgn(r1,r1,r2,RGN_XOR);
    DeleteObject(r2);
    r2 := CreateRectRgn(0,height-shadow_size-1,shadow_size,height-1);
    CombineRgn(r1,r1,r2,RGN_XOR);
    DeleteObject(r2);
    for i := width-shadow_size-1 to width-2 do
    for j := shadow_size to height-2 do
    if (i+j) and 1 = 0 then begin
    r2 := CreateRectRgn(i,j,i+1,j+1);
    CombineRgn(r1,r1,r2,RGN_XOR);
    DeleteObject(r2);
    end;
    for i := shadow_size to width-shadow_size-2 do
    for j := height-shadow_size-1 to height-2 do
    if (i+j) and 1 = 0 then begin
    r2 := CreateRectRgn(i,j,i+1,j+1);
    CombineRgn(r1,r1,r2,RGN_XOR);
    DeleteObject(r2);
    end;
    SetWindowRgn(Handle,r1,true);
    DeleteObject(r1);
    end;

    function TMyHintWindowClass.CalcHintRect(MaxWidth: Integer;
    const AHint: string; AData: Pointer): TRect;
    begin
    Result := Rect(0,0,Canvas.TextWidth(AHint)+10*2,Canvas.TextHeight(AHint)+8*2);
    end;

    constructor TMyHintWindowClass.Create(AOwner: TComponent);
    begin
    inherited Create(AOwner);
    end;

    procedure TMyHintWindowClass.CreateParams(var Params: TCreateParams);
    begin
    inherited CreateParams(Params);
    Params.Style := WS_POPUP;
    end;

    procedure TMyHintWindowClass.Paint;
    const
    shadow_size = 4;
    var
    i,j: integer;
    rc: TRect;
    begin
    with Canvas do begin
    Brush.Color := clInfoText;
    FillRect(ClientRect);
    Brush.Color := clInfoBk;
    Pen.Color := clInfoText;
    Rectangle(0,0,width-shadow_size-1,height-shadow_size-1);
    rc := ClientRect;
    dec(rc.Right,shadow_size+1);
    dec(rc.Bottom,shadow_size+1);
    Windows.DrawText(Handle,pChar(Caption),Length(Caption),rc,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    end;
    end;

    end.
     
  5. Herp

    Herp Гость

    Спасибо, сегодня попробую!
     
  6. mike.dld

    mike.dld Гость

    Сделал вариант побыстрее:
    Код (Text):
    unit Unit1;

    interface

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

    type
    TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    TMyHintWindowClass = class(THintWindow)
    protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    public
    constructor Create(AOwner: TComponent); override;
    procedure ActivateHint(ARect: TRect; const AHint: string); override;
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
    AData: Pointer): TRect; override;
    end;

    var
    Form1: TForm1;
    const
    shadow_size = 5;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    HintWindowClass := TMyHintWindowClass;
    Application.HintPause := 0;
    end;

    { TMyHintWindowClass }

    procedure TMyHintWindowClass.ActivateHint(ARect: TRect;
    const AHint: string);
    var
    rgn: HRGN;
    i,j: integer;
    hrc: DWORD;
    rc: PRgnData;
    rc_cnt: DWORD;
    pr: PRect;
    begin
    inherited ActivateHint(ARect,AHint);
    rc_cnt := 50;
    hrc := GlobalAlloc(GMEM_MOVEABLE,sizeof(RGNDATAHEADER)+sizeof(TRect)*rc_cnt);
    rc := GlobalLock(hrc);
    with rc^.rdh do begin
    dwSize := sizeof(rc^.rdh);
    iType := RDH_RECTANGLES;
    nCount := 1;
    nRgnSize := 0;
    rcBound := ClientRect;
    end;
    PRect(@rc^.Buffer)^ := ClientRect;
    dec(PRect(@rc^.Buffer)^.Right,shadow_size+1);
    dec(PRect(@rc^.Buffer)^.Bottom,shadow_size+1);
    for i := shadow_size to width-1 do//width-shadow_size-1 to width-1 do
    for j := shadow_size to height-1 do
    if ((i+j) and 1 = 0) and not PtInRect(PRect(@rc^.Buffer)^,Point(i,j)) then begin
    if rc^.rdh.nCount+1 > rc_cnt then begin
    inc(rc_cnt,50);
    GlobalUnlock(hrc);
    hrc := GlobalReAlloc(DWORD(rc),sizeof(RGNDATAHEADER)+sizeof(TRect)*rc_cnt,GMEM_MOVEABLE);
    rc := GlobalLock(hrc);
    end;
    pr := PRect(@rc^.Buffer);
    inc(pr,rc^.rdh.nCount);
    SetRect(pr^,i,j,i+1,j+1);
    inc(rc^.rdh.nCount);
    end;
    rgn := ExtCreateRegion(nil,sizeof(RGNDATAHEADER)+(sizeof(TRect)*rc_cnt),rc^);
    GlobalUnlock(hrc);
    GlobalFree(DWORD(hrc));
    SetWindowRgn(Handle,rgn,true);
    DeleteObject(rgn);
    end;

    function TMyHintWindowClass.CalcHintRect(MaxWidth: Integer;
    const AHint: string; AData: Pointer): TRect;
    begin
    Result := inherited CalcHintRect(MaxWidth,AHint,AData);
    inc(Result.Right,5*2+shadow_size);
    inc(Result.Bottom,5*2+shadow_size);
    end;

    constructor TMyHintWindowClass.Create(AOwner: TComponent);
    begin
    inherited Create(AOwner);
    Color := clNone;
    end;

    procedure TMyHintWindowClass.CreateParams(var Params: TCreateParams);
    begin
    inherited CreateParams(Params);
    Params.Style := WS_POPUP;
    end;

    procedure TMyHintWindowClass.Paint;
    var
    rc: TRect;
    begin
    with Canvas do begin
    Brush.Color := clInfoText;
    FillRect(ClientRect);
    Brush.Color := clInfoBk;
    Pen.Color := clInfoText;
    Rectangle(0,0,width-shadow_size-1,height-shadow_size-1);
    rc := ClientRect;
    dec(rc.Right,shadow_size+1);
    dec(rc.Bottom,shadow_size+1);
    InflateRect(rc,-7,-7);
    Windows.DrawText(Handle,pChar(Caption),Length(Caption),rc,DT_LEFT or DT_WORDBREAK);
    end;
    end;

    end.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей