[es] - Delphi i skinovi?

milance_kg

Član broj: 59131
Poruke: 185
212.200.170.*

+22 Profil

^{08.11.2006. u 05:15 - pre 217 meseci}

Evo da bi se odrzao 'Caption', bilo je potrebno
malo znati i WinApi

Code:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    SkinData1: TSkinData;
    procedure FormPaint(Sender: TObject);

  private
    { private declarations }
    FCaption: TCaption;
    procedure CMFontChanged(var Msg: TMessage);
      message CM_FONTCHANGED;
    procedure WMWinIniChange(var Msg: TWMWinIniChange);
      message WM_WININICHANGE;
    procedure WMNCPaint(var Msg: TWMNCPaint);
      message WM_NCPAINT;
    procedure WMNCActivate(var Msg: TWMNCActivate);
      message WM_NCACTIVATE;
    procedure WMActivate(var Msg: TWMNCActivate);
      message WM_ACTIVATE;
    procedure WMSetText(var Msg: TWMSetText);
      message WM_SETTEXT;
    procedure WMSysCommand(var Msg: TWMSysCommand);
      message WM_SYSCOMMAND;
    procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
      message WM_GETMINMAXINFO;
    procedure DrawCaption(AActive: Boolean);

    procedure SetCaption(const Value: TCaption);
  protected
    { protected declarations }
  public
    { public declarations }

  published
    { published declarations }
    property Caption: TCaption read FCaption write SetCaption;
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.DrawCaption(AActive: Boolean);
var
  iNCM: TNonClientMetrics;
  iRect: TRect;
  iCanvas: TCanvas;
  iFlags: Integer;
  Natpis: string;
begin
  Natpis := 'Milan';
  if (BorderStyle <> bsNone) then
  begin
    iRect.Left := 30;
    iRect.Top  := 9;
    iRect.Bottom   := 25;
    iRect.Right    := 200;
    iCanvas        := TCanvas.Create;
    iCanvas.Handle := GetWindowDC(Handle);
    with iCanvas do
      try
        Font := Self.Font;
        iNCM.cbSize := SizeOf(iNCM);
        SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(iNCM), @iNCM,
          0);
        if (BorderStyle in [bsToolWindow, bsSizeToolWin]) then
          Font.Height := ((iNCM.lfCaptionFont.lfHeight * 7) div 8)
        else
          Font.Height := iNCM.lfCaptionFont.lfHeight;
        if (iNCM.lfCaptionFont.lfWeight < 700) then
          Font.Style := []
        else
          Font.Style := [fsBold];
        Font.Size := 12;
        Brush.Style := bsClear;
        iFlags := DT_EXPANDTABS or DT_LEFT or DT_VCENTER or
          DT_SINGLELINE or DT_END_ELLIPSIS;
        iFlags := DrawTextBiDiModeFlags(iFlags);
        if (AActive) then
        begin
          Font.Color := GetSysColor(COLOR_BACKGROUND);
          OffsetRect(iRect, + 1, + 1);
          DrawText(Handle, PChar(Natpis), - 1, iRect, iFlags);
          OffsetRect(iRect, - 1, - 1);
          Font.Color := GetSysColor(COLOR_CAPTIONTEXT)
        end
        else
          Font.Color := GetSysColor(COLOR_GRAYTEXT);
        DrawText(Handle, PChar(Natpis), - 1, iRect, iFlags)
      finally
        ReleaseDC(Self.Handle, Handle);
        iCanvas.Free
      end;
  end;
end;

procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
  inherited;
  DrawCaption(Msg.Active)
end;

procedure TForm1.WMActivate(var Msg: TWMNCActivate);
begin
  inherited;
  DrawCaption(Msg.Active)
end;

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
  inherited;
  DrawCaption(Active)
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  inherited;
  DrawCaption(Active)
end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  inherited;
  DrawCaption(Active)
end;

procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin { TForm1.WMGetMinMaxInfo }
  inherited;
  DrawCaption(Active)
end;

procedure TForm1.SetCaption(const Value: TCaption);
begin
  if (FCaption <> Value) then
  begin
    FCaption := Value;
    Perform(WM_NCPAINT, 0, 0)
  end;
end;

procedure TForm1.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  Perform(WM_NCPAINT, 0, 0)
end;

procedure TForm1.WMWinIniChange(var Msg: TWMWinIniChange);
begin
  inherited;
  Perform(WM_NCPAINT, 0, 0)
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  inherited;
  DrawCaption(Active)
end;

end.

Pozdrav.

p.s.

Prilozen je i primer.

Prikačeni fajlovi

caption1.zip - 47.61k

Odgovor na temu

bojan21
Bojan Zukic
Beograd

Član broj: 101113
Poruke: 251
*.cpe.vektor.net.

+6 Profil

Re: Delphi i skinovi?

^{28.05.2007. u 23:04 - pre 210 meseci}

Meni je za seminarski trebala skin komponenta (seminarski asm trebao da pokrenem na win2000, a ja sam hteo da aplikacija izgleda fancy), i trazio sam ih na netu, downloadovao sve i svasta! Sve komponente su bile SW, izbacivae su neke errore, warninge, menjale caption i sl.

Na kraju sam skinuo komponentu DynamicSkinForm sa sajta http://www.almdev.com/

Skinuo sam i primere aplikacija sa source-om! Medjutim i ova komponenta je bila SW i aplikacija mi je izbacivala poruku da koristim neregistrovanu verziju pri pokretanju! Medjutim, jednom sam slucajno editovao njihov maindemo i pokrenuo ga i nije mi izbacivao nikakve poruke! Zatim sam ceo kod moje aplikacije prekopirao u njihov demo (prvo ga ispraznio) i komponenta je "mislila" da je registrovana! Program sam zavrsio i dodao skinove i sve normalno radi bez ikakvim SW upozorenja! Tako da ako neko josh ne moze da nadje pravo resenje za skinove, nek skine gore navedenu komponentu i svoj projekat pocne da gradi iz njihovog demo-a!

Pozdrav

Odgovor na temu