paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-03 21:19:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

implemented TBitBtn override GetDefaultBitBtnGlyph

Browse Source 
git-svn-id: trunk@7997 -
This commit is contained in:
mattias 2005-10-29 15:58:40 +00:00
parent 11e44fac38
commit 912b242bea
4 changed files with 48 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/synedit/synedit.pp
View File

@ -5679,6 +5679,7 @@ var
ScrollHint: THintWindow;
{$ENDIF}
begin
//debugln('TCustomSynEdit.WMVScroll A ',DbgSName(Self),' Msg.ScrollCode=',dbgs(Msg.ScrollCode),' SB_PAGEDOWN=',dbgs(SB_PAGEDOWN),' SB_PAGEUP=',dbgs(SB_PAGEUP));
case Msg.ScrollCode of
// Scrolls to start / end of the text
SB_TOP: TopLine := 1;

20
lcl/buttons.pp
View File

@ -213,6 +213,8 @@ type
{ TBitBtn }
{ To set custom bitbtn glyphs for the whole application, see below for
GetDefaultBitBtnGlyph }
TBitBtn = class(TCustomBitBtn)
published
@ -372,7 +374,25 @@ type
property PopupMenu;
end;
{ To override the default TBitBtn glyphs set GetDefaultBitBtnGlyph below.
Example:
function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
begin
if Kind in [bkOK, bkCancel] then begin
Result:=TBitmap.Create;
case Kind of
bkOk: Result.Assign(MyOkGlyph);
bkCancel: Result.Assign(MyCancelGlyph);
end;
end else
Result:=nil;
end;
}
type
TGetDefaultBitBtnGlyph = function(Kind: TBitBtnKind): TBitmap;
var
GetDefaultBitBtnGlyph: TGetDefaultBitBtnGlyph = nil;
procedure Register;

25
lcl/include/bitbtn.inc
View File

@ -164,15 +164,28 @@ end;
procedure TCustomBitBtn.RealizeKind;
var
ABitmap: TBitmap;
GlyphValid: Boolean;
CustomGlyph: TBitmap;
begin
if (Kind<>bkCustom)
then begin
ABitmap := Glyph;
if ABitmap = nil
then ABitmap := TBitmap.Create;
ABitmap.Handle := LoadStockPixmap(BitBtnImages[FKind]);
Glyph := ABitmap;
GlyphValid:=false;
// first let the user override
if GetDefaultBitBtnGlyph<>nil then begin
CustomGlyph:=GetDefaultBitBtnGlyph(Kind);
if CustomGlyph<>nil then begin
Glyph.Assign(CustomGlyph);
CustomGlyph.Free;
GlyphValid:=true;
end;
end;
// then ask the widgetset
if not GlyphValid then begin
Glyph.Handle := LoadStockPixmap(BitBtnImages[FKind]);
GlyphValid:=true;
end;
end;
if not (csLoading in ComponentState)

13
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -2451,7 +2451,7 @@ end;
{$IFDEF gtk1}
function gtk_range_get_update_policy(range: PGTKRange): TGtkUpdateType;
begin
result := policy(Range^)
result := policy(Range^);
end;
{$ENDIF}
@ -2466,7 +2466,7 @@ type
{$ENDIF}
begin
{$IFDEF gtk1}
Result :=Scroll_type(Range^);
Result := Scroll_type(Range^);
{$ELSE}
if (gtk_major_version=2) and (gtk_minor_version<6) and
(Range^.Timer<>nil) then
@ -2531,7 +2531,7 @@ begin
if IsVertSB then
Result := SB_PAGEDOWN
else
Result := SB_PAGERIGHT;
Result := SB_PAGERIGHT;
{$ifdef GTK2}
GTK_SCROLL_STEP_UP:
Result := SB_LINEUP;
@ -2631,7 +2631,7 @@ begin
ScrollBar := HWND(Scroll);
ScrollType := get_gtk_scroll_type(Scroll);
ScrollCode := ScrollTypeToSbCode(False, ScrollType,
gtk_range_get_update_policy(Scroll));
gtk_range_get_update_policy(Scroll));
end;
DeliverMessage(Data, Msg);
end;
@ -2653,10 +2653,13 @@ begin
if Pos < High(SmallPos)
then SmallPos := Pos
else SmallPos := High(SmallPos);
//DebugLn('GTKVScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos));
ScrollBar := HWND(Scroll);
ScrollType := get_gtk_scroll_type(Scroll);
// GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction.
ScrollCode := ScrollTypeToSbCode(True, ScrollType,
gtk_range_get_update_policy(Scroll));
gtk_range_get_update_policy(Scroll));
//DebugLn('GTKVScrollCB B Adjustment^.Value=',dbgs(Adjustment^.Value),' ScrollCode=',dbgs(ScrollCode),' ScrollType=',dbgs(ScrollType));
end;
DeliverMessage(Data, Msg);
end;