ana sayfa > Delphi > UpdateLayeredWindow II

UpdateLayeredWindow II

Cuma, 11 Eyl 2009 yorum ekle yorumlara git

Tekrar merhabalar. Bu yazımda bir önceki yazıda anlatmaya çalıştığım
UpdateLayeredWindow apisi ile Vista ve Win 7′ de gelen sidebardaki gadgets (küçük alet)
tarzı programların nasıl oluşturulabileceğini göstermek istiyorum.

saatprogrami

UpdateLayeredWindow ile oluşturulan pençereler bir bitmap resme ihtiyaç duruyor ve
bu resim pençere üzerine çizildikten sonra WM_PAINT messajı çağrılsa bile pençere normal
çizim işlemlerini yapmıyordu. Ayrıca üzerine konan bileşenler bir alttaki katmana (layer)
göre çizim yaptığından ekranda gözükmüyordu.
Bunu sorunu aşmak örnek iki bişen olşturdum ve bu bilenlere Skin adında özellik
ekleyerek TSplashEkran bileşenin Resim özelliğinin üzerine bileşenleri çizdirip tekrar
Execute fonksiyonunu çağırdım.
Örneğim için bir label ve button gerektiği için şimdilik bunları oluşturdum.
İleride bir Edit bileşeni yazmaya çalışacağım, gerçi yazmaya çalıştım fakar bir Edit
bileşenin bu kadar karmaşık olabileceği aklıma gelmemişti. :) İsterseniz sizler yazıp
bana gönderip ve burada yayınlayalım.
Örneğim saat ve günün tarihini gösteren basit bir program. Siz bu kalıbı takip
ederek daha karmaşık programlar oluşturabilirsiniz.

Bileşenlerimiz:

1. TNoktaLabel:
Bileşende Paint fonksiyonunda iki türlü çizim var.
Birincisi designtime da formda gözükmesi için kendi canvasın üzerine çizim
yapılıyor. Runtime da ise temp bitmap oluşturarak ve ayrıcada Splah üzerindeki
buffer dan yerleşim yerinden arka zemin alarak bunu tekrar splah bileşenin Resim
bitmapına aktarıp Execute yordamını çağırıyor. (Eh biraz zor oldu :) )

unit noktalabel;

interface

uses
  SysUtils,
  Classes,
  Controls,
  StdCtrls,
  Messages,
  windows,
  splashekran,
  Graphics;

type
  Thiza = (hSol, hOrta, hSag);

  TNoktaLabel = class(TCustomControl)
  private
    FCaption: string;
    FSkin: TSplashEkran;
    fFontChanged: boolean;
    FHiza: Thiza;
    procedure SetSkin(const Value: TSplashEkran);
    procedure SetHiza(const Value: Thiza);

    { Private declarations }
  protected
    // Eh bunada smoth font yakışır. Fontu AntiAliased yapmak için.
    procedure SetFontSmoothing(AFont: TFont);
    procedure Paint; override;
    // Font değişince tekrar çizmek için.
    procedure CMFontchanged(var message: TMessage);
    message CM_FONTCHANGED;
    // Yazı değişince tekrar çizmek için.
    procedure CMTextchanged(var message: TMessage);
    message CM_TEXTCHANGED;

    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }

  published
    property Align;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseDown;
    property OnClick;
    property Caption;
    property Skin: TSplashEkran read FSkin write SetSkin;
    property Hiza: Thiza read FHiza write SetHiza default hSol;
    property Font;
    { Published declarations }
  end;

procedure register;

implementation

procedure register;
begin
  RegisterComponents(‘NoktaComp’, [TNoktaLabel]);
end;
{ TNoktaLabel }

procedure TNoktaLabel.SetFontSmoothing(AFont: TFont);
var
  tagLOGFONT: TLogFont;
begin
  GetObject(AFont.Handle, SizeOf(TLogFont), @tagLOGFONT);
  tagLOGFONT.lfQuality := ANTIALIASED_QUALITY;
  AFont.Handle := CreateFontIndirect(tagLOGFONT);
end;

procedure TNoktaLabel.SetHiza(const Value: Thiza);
begin
  if FHiza <> Value then
  begin
    FHiza := Value;
    Invalidate;
  end;
end;

procedure TNoktaLabel.CMFontchanged(var message: TMessage);
begin
  Canvas.Font.Assign(Font);
  Invalidate;
end;

procedure TNoktaLabel.CMTextchanged(var message: TMessage);
begin
  Invalidate;
end;

constructor TNoktaLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHiza := hSol;
end;

destructor TNoktaLabel.Destroy;
begin
  inherited;
end;

procedure TNoktaLabel.Paint;
var
  temp: TBitmap;
  LF: TLogFont;
  r: TRect;
begin
  r := GetClientRect;
  InflateRect(r, -1, -1);
  if not fFontChanged then
  begin
    GetObject(Font.Handle, SizeOf(TLogFont), @LF);
    LF.lfQuality := ANTIALIASED_QUALITY;
    Font.Handle := CreateFontIndirect(LF);
    fFontChanged := TRUE;
  end;
  if (FSkin <> nil) and (FSkin.Resim <> nil) and not(csDesigning in ComponentState) then
  begin
   // burası runtime çizimi için.
    temp := TBitmap.Create;
    temp.Width := Width;
    temp.Height := Height;
    temp.PixelFormat := pf24bit;
    temp.Canvas.Font.Assign(Font);
    temp.Canvas.Brush.Style := bsSolid;
    temp.Canvas.CopyRect(rect(0, 0, Width, Height), FSkin.Fbuffer.Canvas, rect
            (Left, Top, Left + Width, Top + Height));
    temp.Canvas.Brush.Style := bsClear;
    end;
    case FHiza of
      hSol:
        DrawText(temp.Canvas.Handle, Caption, -1, r, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
      hOrta:
        DrawText(temp.Canvas.Handle, Caption, -1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      hSag:
        DrawText(temp.Canvas.Handle, Caption, -1, r, DT_SINGLELINE or DT_RIGHT or DT_VCENTER);
    end;
    FSkin.Resim.Canvas.Draw(Left, Top, temp);
    FSkin.Execute;
    temp.Free;
  end
  else
  begin
   // burası design time çizim için
    Canvas.Brush.Style := bsClear;
    case FHiza of
      hSol:
        DrawText(Canvas.Handle, Caption, -1, r, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
      hOrta:
        DrawText(Canvas.Handle, Caption, -1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
      hSag:
        DrawText(Canvas.Handle, Caption, -1, r, DT_SINGLELINE or DT_RIGHT or DT_VCENTER);
    end;
  end;
end;

procedure TNoktaLabel.SetSkin(const Value: TSplashEkran);
begin
  FSkin := Value;
end;

end.

2.TGraphicTus2

Bu bileşen üç duruma göre üç farklı resim tutuyor. Normal, üzerinde ve tıklama.
Aynı şekilde bu bileşen içinde runtime ve designtime çizimleri ayrı ayrı ve runtimeda Splah
bileşenin resmin üzerine çizim yapıyor. Kendisi zaten png resimlerini çizdiği için Splah
bileşenin bufferından resim almayı gerek duymadım.

unit GraphicControl1;

interface

uses
  SysUtils,
  Classes,
  Controls,
  splashekran,
  graphics,
  pngimage,
  Messages,
  Windows;

type
  TDurum = (dNormal, dUstunde, dTiklama);

type
  TGraphicTus2 = class(TCustomControl)
  private
    FDurum: TDurum;
    fmouse: boolean;
    FSkin: TSplashEkran;
    FTiklamaResim: TPngImage;
    FUstResim: TPngImage;
    FNormalResim: TPngImage;
    procedure SetSkin(const Value: TSplashEkran);
    procedure SetNormalResim(const Value: TPngImage);
    procedure SetTiklamaResim(const Value: TPngImage);
    procedure SetUstResim(const Value: TPngImage);

    { Private declarations }
  protected
    procedure Paint; override;
    procedure CMMouseenter(var message: TMessage);
    message CM_MOUSEENTER;
    procedure CMMouseleave(var message: TMessage);
    message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure CMFontchanged(var message: TMessage);
    message CM_FONTCHANGED;
    procedure CMTextchanged(var message: TMessage);
    message CM_TEXTCHANGED;

    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    { Public declarations }
  published
    property Font;
    property OnClick;
    property Skin: TSplashEkran read FSkin write SetSkin;
    property NormalResim: TPngImage read FNormalResim write SetNormalResim;
    property UstResim: TPngImage read FUstResim write SetUstResim;
    property TiklamaResim: TPngImage read FTiklamaResim write SetTiklamaResim;
    { Published declarations }
  end;

procedure register;

implementation

procedure register;
begin
  RegisterComponents(‘NoktaComp’, [TGraphicTus2]);
end;
{ TGraphicTus2 }

procedure TGraphicTus2.CMFontchanged(var message: TMessage);
begin
  Canvas.Font.Assign(Font);
  Invalidate;
end;

procedure TGraphicTus2.CMMouseenter(var message: TMessage);
begin
  if csDesigning in ComponentState then
    exit;
  fmouse := true;
  FDurum := dUstunde;
  Invalidate;
end;

procedure TGraphicTus2.CMMouseleave(var message: TMessage);
begin
  if csDesigning in ComponentState then
    exit;
  fmouse := false;
  FDurum := dNormal;
  Invalidate;
end;

procedure TGraphicTus2.CMTextchanged(var message: TMessage);
begin
  Invalidate;
end;

constructor TGraphicTus2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FNormalResim := TPngImage.Create;
  FUstResim := TPngImage.Create;
  FTiklamaResim := TPngImage.Create;
  FDurum := dNormal;
end;

destructor TGraphicTus2.Destroy;
begin
  FNormalResim.Free;
  FUstResim.Free;
  FTiklamaResim.Free;
  inherited;
end;

procedure TGraphicTus2.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Windows.SetFocus(Handle);
  FDurum := dTiklama;
  Invalidate;
  inherited;
end;

procedure TGraphicTus2.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if fmouse then
  begin
    FDurum := dUstunde;
    Invalidate;
  end;
end;

procedure TGraphicTus2.Paint;
var
  r: trect;
begin
  FTiklamaResim.Canvas.Brush.Style := bsClear;
  FNormalResim.Canvas.Brush.Style := bsClear;
  FUstResim.Canvas.Brush.Style := bsClear;
  Canvas.Brush.Style := bsClear;
  r := GetClientRect;
  case FDurum of
    dNormal:
      if (Skin <> nil) and (Skin.Resim <> nil) and not(csDesigning in ComponentState) then
        Skin.Resim.Canvas.Draw(Left, Top, FNormalResim)
      else
        Canvas.Draw(0, 0, FNormalResim);
    dUstunde:
      if (Skin <> nil) and (Skin.Resim <> nil) and not(csDesigning in ComponentState) then
        Skin.Resim.Canvas.Draw(Left, Top, FUstResim)
      else
        Canvas.Draw(0, 0, FUstResim);
    dTiklama:
      if (Skin <> nil) and (Skin.Resim <> nil) and not(csDesigning in ComponentState) then
        Skin.Resim.Canvas.Draw(Left, Top, FTiklamaResim)
      else
        Canvas.Draw(0, 0, TiklamaResim);
  end;
  if (Skin <> nil) and (Skin.Resim <> nil) and not(csDesigning in ComponentState) then
    Skin.Execute;
end;

procedure TGraphicTus2.SetNormalResim(const Value: TPngImage);
begin
  Width := Value.Width;
  Height := Value.Height;
  FNormalResim.Assign(Value);
  Invalidate;
end;

procedure TGraphicTus2.SetSkin(const Value: TSplashEkran);
begin
  FSkin := Value;
end;

procedure TGraphicTus2.SetTiklamaResim(const Value: TPngImage);
begin
  FTiklamaResim.Assign(Value);
  Invalidate;
end;

procedure TGraphicTus2.SetUstResim(const Value: TPngImage);
begin
  FUstResim.Assign(Value);
  Invalidate;
end;

end.

Yazının altında programın exe ve kodlarını bulabilirsiniz.
Kolay gelsin.

İlgili Dosya:
Saat

Categories: Delphi Tags:
  1. şimdilik yorum yok.
  1. şimdilik geri bağlantı yok