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.
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 🙂 )
[code lang=”Delphi”]
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.
[/code]
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.
[code lang=”Delphi”]
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.
[/code]
Yazının altında programın exe ve kodlarını bulabilirsiniz.
Kolay gelsin.
İlgili Dosya:
Saat