ich weiss zwar dass crosspostings nicht so beliebt sind, aber trotzdem

ich hab versucht folgende Unit in Lazarus( 09.29) einzubinden, da ich die Funktionalität der deaktivierten Tabs brauche.
Leider funkts nur unter Delphi,unter Lazarus nicht

woran liegts, kann man das auch unter Lazarus hinkriegen?
hier der Code:
original Hier:
http://groups.google.de/group/borland.p ... 8d9920a342" onclick="window.open(this.href);return false;
Code: Alles auswählen
unit PBPageControl;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ComCtrls;
type
TPBPageControl = class(TPageControl)
private
{ Private declarations }
Procedure WMLButtonDown( Var msg: TWMLButtonDown ); message
WM_LBUTTONDOWN;
Procedure CMDialogKey( Var msg: TWMKey ); message CM_DIALOGKEY;
procedure SetOwnerdraw(const Value: Boolean);
function GetOwnerdraw: Boolean;
protected
{ Protected declarations }
procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active:
Boolean);
override;
public
{ Public declarations }
Constructor Create( aOwner: TCOmponent ); override;
published
{ Published declarations }
property Ownerdraw: Boolean read GetOwnerdraw write SetOwnerdraw
default
True;
end;
procedure Register;
implementation
Uses CommCtrl;
procedure Register;
begin
RegisterComponents('PBGoodies', [TPBPageControl]);
end;
{ TPBPageControl }
procedure TPBPageControl.CMDialogKey(var msg: TWMKEY);
var
thistab, tab: TTabSheet;
forward: Boolean;
begin
If (msg.CharCode = Ord(#9)) and (GetKeyState( VK_CONTROL ) < 0) Then
Begin
thistab := ActivePage;
forward := GetKeyState( VK_SHIFT ) >= 0;
tab := thistab;
Repeat
tab := FindNextPage( tab, forward, true );
Until tab.Enabled or (tab = thistab);
If tab <> thistab Then Begin
If CanChange Then Begin
ActivePage := tab;
Change;
End;
Exit;
End;
End;
inherited;
end;
constructor TPBPageControl.Create(aOwner: TCOmponent);
begin
inherited;
OwnerDraw := True;
end;
procedure TPBPageControl.DrawTab(TabIndex: Integer; const Rect: TRect;
Active: Boolean);
var
imageindex: Integer;
r: TRect;
S: String;
begin
If not Pages[TabIndex].Enabled Then
Canvas.Font.Color := clGrayText;
If Active Then
Canvas.Font.Style := [fsBold];
If Assigned( OnDrawTab ) Then
inherited
Else Begin
r:= Rect;
Canvas.Fillrect( r );
imageindex := GetImageIndex( tabindex );
If (imageindex >=0) and Assigned( Images ) Then Begin
SaveDC( canvas.handle );
images.Draw( Canvas, Rect.Left+4, Rect.Top+2,
imageindex,
Pages[TabIndex].enabled );
// images.draw fouls the canvas colors if it draws
// the image disabled, thus the SaveDC/RestoreDC
RestoreDC( canvas.handle, -1 );
R.Left := R.Left + images.Width + 4;
End;
S:= Pages[ TabIndex ].Caption;
InflateRect( r, -2, -2 );
DrawText( Canvas.handle,
PChar(S),
Length(S),
r,
DT_SINGLELINE or DT_LEFT or DT_TOP );
End;
end;
function TPBPageControl.GetOwnerdraw: Boolean;
begin
result := inherited OwnerDraw;
end;
procedure TPBPageControl.SetOwnerdraw(const Value: Boolean);
begin
inherited OwnerDraw := true;
end;
procedure TPBPageControl.WMLButtonDown(var msg: TWMLButtonDown);
var
hi: TTCHitTestInfo;
tabindex: Integer;
begin
If csDesigning In ComponentState Then Begin
inherited;
Exit;
End;
hi.pt.x := msg.XPos;
hi.pt.y := msg.YPos;
hi.flags := 0;
tabindex := Perform( TCM_HITTEST, 0, longint(@hi));
If (tabindex >= 0) and ((hi.flags and TCHT_ONITEM) <> 0)
Then
If not Pages[ tabindex ].Enabled Then Begin
msg.result := 0;
Exit;
End;
inherited;
end;
end.
Gruss KHH