NOT : Lütfen sorularımızı foruma soralım.selam arkadaşlar ben win toolbar daki yeni araç çubuklarından adres çubuğu gibi kendi yapmış olduğum programı oraya yerleştirmek istiyorum lütfen yardımcı olun
herkeze şimdiden teşekkürler
Kod: Tümünü seç
unit ApplicationBar;
interface
uses Windows, Messages, SysUtils, Forms, ShellAPI, Classes, Controls;
type
TAppBarEdge = (abeTop, abeBottom, abeLeft, abeRight);
EAppBarError = class(Exception);
TAppBar = class(TCustomForm)
private
FABD : TAppBarData;
FDockedHeight : Integer;
FDockedWidth : Integer;
FEdge : TAppBarEdge;
FOnEdgeChanged : TNotifyEvent;
FTopMost : Boolean;
procedure WMActivate(var M: TMessage); message WM_ACTIVATE;
procedure WMWindowPosChanged(var M: TMessage); message
WM_WINDOWPOSCHANGED;
function SendAppBarMsg(Msg: DWORD): UINT;
procedure SetAppBarEdge(Value: TAppBarEdge);
procedure SetAppBarPos(Edge: UINT);
procedure SetTopMost(Value: Boolean);
procedure SetDockedHeight(const Value: Integer);
procedure SetDockedWidth(const Value: Integer);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure WndProc(var M: TMessage); override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0);
override;
property DockManager;
published
property Action;
property ActiveControl;
property AutoScroll;
property AutoSize;
property BiDiMode;
property BorderWidth;
property Caption;
property Color;
property Ctl3D;
property DockedHeight: Integer read FDockedHeight write
SetDockedHeight default 35;
property DockedWidth: Integer read FDockedWidth write
SetDockedWidth default 40;
property UseDockManager;
property DefaultMonitor;
property DockSite;
property DragKind;
property DragMode;
property Edge: TAppBarEdge read FEdge write SetAppBarEdge default
abeTop;
property Enabled;
property ParentFont default False;
property Font;
property FormStyle;
property Height;
property HelpFile;
property HorzScrollBar;
property Icon;
property KeyPreview;
property Menu;
property OldCreateOrder;
property ObjectMenuItem;
property ParentBiDiMode;
property PixelsPerInch;
property PopupMenu;
property Position;
property PrintScale;
property Scaled;
property ShowHint;
property TopMost: Boolean read FTopMost write SetTopMost default
False;
property VertScrollBar;
property Visible;
property Width;
property WindowState;
property WindowMenu;
property OnActivate;
property OnCanResize;
property OnClick;
property OnClose;
property OnCloseQuery;
property OnConstrainedResize;
property OnContextPopup;
property OnCreate;
property OnDblClick;
property OnDestroy;
property OnDeactivate;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEdgeChanged: TNotifyEvent read FOnEdgeChanged write
FOnEdgeChanged;
property OnEndDock;
property OnGetSiteInfo;
property OnHide;
property OnHelp;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnPaint;
property OnResize;
property OnShortCut;
property OnShow;
property OnStartDock;
property OnUnDock;
end;
implementation
var
AppBarMsg: UINT;
constructor TAppBar.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
FDockedHeight := 35;
FDockedWidth := 40;
inherited CreateNew(AOwner, Dummy);
ClientHeight := 35;
Width := 100;
BorderStyle := bsNone;
BorderIcons := [];
FABD.cbSize := sizeOf(FABD);
FABD.uCallbackMessage := AppBarMsg;
end;
procedure TAppBar.WMWindowPosChanged(var M: TMessage);
begin
inherited;
SendAppBarMsg(ABM_WINDOWPOSCHANGED);
end;
procedure TAppBar.WMActivate(var M: TMessage);
begin
inherited;
SendAppBarMsg(ABM_ACTIVATE);
end;
procedure TAppBar.WndProc(var M: TMessage);
var State: UINT;
begin
if M.Msg = AppBarMsg then
begin
case M.WParam of
ABN_STATECHANGE: begin
State := SendAppBarMsg(ABM_GETSTATE);
if ABS_ALWAYSONTOP and State = 0 then
SetTopMost(False) else
SetTopMost(True);
end;
ABN_FULLSCREENAPP: begin
State := SendAppBarMsg(ABM_GETSTATE);
if M.LParam <> 0 then
begin
if ABS_ALWAYSONTOP and State = 0 then
SetTopMost(False) else
SetTopMost(True);
end else
if State and ABS_ALWAYSONTOP <> 0
then
SetTopMost(True);
end;
ABN_POSCHANGED: begin
SetAppBarPos(FABD.uEdge);
end;
end;
end else
inherited WndProc(M);
end;
function TAppBar.SendAppBarMsg(Msg: DWORD): UINT;
begin
if csDesigning in ComponentState then Result := 0
else Result := SHAppBarMessage(Msg, FABD);
end;
procedure TAppBar.SetAppBarPos(Edge: UINT);
begin
if csDesigning in ComponentState then Exit;
FABD.uEdge := Edge;
with FABD.rc do
begin
Top := 0;
Left := 0;
Right := Screen.Width;
Bottom := Screen.Height;
SendAppBarMsg(ABM_QUERYPOS);
case Edge of
ABE_LEFT: Right := Left + FDockedWidth;
ABE_RIGHT: Left := Right - FDockedWidth;
ABE_TOP: Bottom := Top + FDockedHeight;
ABE_BOTTOM: Top := Bottom - FDockedHeight;
end;
SendAppBarMsg(ABM_SETPOS);
end;
BoundsRect := FABD.rc;
end;
procedure TAppBar.SetTopMost(Value: Boolean);
const
WndPosArray: array[Boolean] of HWND = (HWND_BOTTOM, HWND_TOPMOST);
begin
if FTopMost <> Value then
begin
FTopMost := Value;
if not (csDesigning in ComponentState) then
SetWindowPos(Handle, WndPosArray[Value], 0, 0, 0, 0,
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
end;
end;
procedure TAppBar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if not (csDesigning in ComponentState) then
begin
Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST or
WS_EX_WINDOWEDGE;
Params.Style := Params.Style or WS_DLGFRAME;
end;
end;
procedure TAppBar.CreateWnd;
begin
inherited CreateWnd;
FABD.hWnd := Handle;
if not (csDesigning in ComponentState) then
begin
if SendAppBarMsg(ABM_NEW) = 0 then
raise EAppBarError.Create('Failed to create AppBar');
SetAppBarEdge(FEdge);
end;
end;
procedure TAppBar.DestroyWnd;
begin
SendAppBarMsg(ABM_REMOVE);
inherited DestroyWnd;
end;
procedure TAppBar.SetAppBarEdge(Value: TAppBarEdge);
const
EdgeArray: array[TAppBarEdge] of UINT =
(ABE_TOP, ABE_BOTTOM, ABE_LEFT, ABE_RIGHT);
begin
SetAppBarPos(EdgeArray[Value]);
FEdge := Value;
if assigned(FOnEdgeChanged) then FOnEdgeChanged(Self);
end;
procedure TAppBar.SetDockedHeight(const Value: Integer);
begin
if FDockedHeight <> Value then
begin
FDockedHeight := Value;
SetAppBarEdge(FEdge);
end;
end;
procedure TAppBar.SetDockedWidth(const Value: Integer);
begin
if FDockedWidth <> Value then
begin
FDockedWidth := Value;
SetAppBarEdge(FEdge);
end;
end;
initialization
AppBarMsg := RegisterWindowMessage('ApplicationBarMessage');
end.
Google'dan arattım bulduğum link şu... Bari bunu yazsaydın...
....
Nasıl yapıldığını ben bilmiyorum ki onu açıklayayım Windows message larla da bir iş yüzünden bu aralar uğraşıyorum.))
İşte şu yazdıklarını başına yazssaydın, sana gönderme yapmazdım.. 
DivXTurk Programı o kadar çok şey yapıyor ki onları az yere sığdırmaya çalıştım desem Şaka bir yana, Selçuk ŞENER isimli DivXTurk Kullanıcı bir arkadaşımın tasarımı... Kendisi programı beğenmiş, bedava olduğunu da görünce kendisinin de çorbada tuzu bulunsun istemiş. Bu güzel jestini kırmak bir yana ben de sayfayı beğendim aslında. Logo ve Sayfa çok uyumlu... Sana hak vermemek de yanlış olur aslında, host ve güncelleme bende ama kendisinden manevi telif adına bir görüşürüm. Önerin için ayrıca teşekkürler...
.... Önerin için teşekkürler, gerektiğinde yardımcı olacağını bilmek güzel... Delphi programcılığında öncelik sırası fonksiyonellik ve sistem kaynak tüketimi sınırını en alt düzeyde tutmak 1.Sırada, GUI ise 2.sırada yer alır. Şahsen uguladığım, sürüm ve build numarasını da belirleyen bu unsurlar. 3, 4, 5 sürümler ise yılların birikimi olur. Bu programı ortak kullanıma açma fikri yakın bir arkadaşımın ısrarı ile oldu. 2. sürüme kadar piyasaya çıkmayacaktı, kullananlar da memnu olunca bana bu haliyle release etmek düşerdi ve de yaptım... Bu açıdan hiç baktın mı ? GUI alışkanlık meselesidir. Alışık olduğu tarzda yenilik ister bu doğal.. Ekran formunda dolayı kullanmayan zaten kullanmıyordur. Göstergeler bakılırsa bu sebeple kullanmak istemeyen varsa bile bir o kadar daha insan bunu önemsemiyor... Çünkü ticari bir kaygı yok.. Herkesin kendi gelir kaynağı var zaten... Siteyi logoya uyarlamak konusuna gelince nasıl böyle bir çıkarımda bulundun anlamadım.
....