ec2ce65753
git-svn-id: https://svn.code.sf.net/p/kolmck/code@76 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
2724 lines
80 KiB
ObjectPascal
2724 lines
80 KiB
ObjectPascal
{ ToGRush -- (C) by Vladimir Kladov, 2010
|
|
This version is compatible only with KOL + Grush Controls of version 3.00+
|
|
|
|
Purpose: provides easy way to convert KOL project to use Grush controls
|
|
inplace of standard Windows controls. To use it in most cases it is
|
|
sufficiently to add ToGrush into uses clause after the KOL.pas, KOLadd.pas
|
|
and other KOL units. Use also symbols defined below to change options.
|
|
Note, that with symbol TOGRUSH_OPTIONAL, it is possible to create dual view
|
|
project, controlling if Grush controls are used or not via a variable
|
|
NoGrush.
|
|
|
|
KOLGRushControls are created (C) by Karpinsky Alexander aka homm in 2007.
|
|
}
|
|
|
|
unit ToGRush;
|
|
|
|
interface
|
|
|
|
{$I KOLDEF.inc}
|
|
|
|
{$IFDEF EXTERNAL_DEFINES}
|
|
{$INCLUDE EXTERNAL_DEFINES.INC}
|
|
{$ENDIF EXTERNAL_DEFINES}
|
|
|
|
//{$DEFINE TOGRUSH_AUTO_DISIMAGES} // add this symbol to provide 256 gray images
|
|
// based on original ones for Disabled state
|
|
// of toolbar buttons
|
|
//{$DEFINE TOGRUSH_AUTO_DIS_EQ} // RGB channels of the same level while TOGRUSH_AUTO_DISIMAGES
|
|
//{$DEFINE TOGRUSH_DROPBTN2} // Drop button will be placed right to the button
|
|
// having property DropDown, not in the button
|
|
//{$DEFINE TOGRUSH_NO_AUTO_SIZE_BTNS} // not use AutoSize for buttons
|
|
// (sensible only in a case, when only images are in the toolbar)
|
|
|
|
//{$DEFINE TOGRUSH_NO_MESSAGEBOX} // not use MessageBox replacement
|
|
//{$DEFINE TOGRUSH_NO_SCROLLBARS} // not convert scrollbar colors for ScrollBar controls
|
|
|
|
//{$DEFINE TOGRUSH_OPTIONAL} // define it to allow controlling if actually use GRush controls or not
|
|
// (via variable NoGRush)
|
|
|
|
uses Windows, Messages, KOL, KOLGRushControls;
|
|
|
|
function NewButton( AParent: PControl; const Caption: KOLString ): PControl;
|
|
|
|
function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl;
|
|
function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl;
|
|
|
|
function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
|
|
|
|
function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl;
|
|
function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer;
|
|
EdgeStyle: TEdgeStyle ): PControl;
|
|
|
|
var GRush_Force_Flat_Toolbars: Boolean;
|
|
function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions;
|
|
Bitmap: HBitmap; const Buttons: array of PKOLChar;
|
|
const BtnImgIdxArray: array of Integer ) : PControl;
|
|
procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar;
|
|
const BtnImgIdxArray: array of Integer; Bitmap: HBitmap );
|
|
function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect;
|
|
procedure ToolbarSetTooltips( Toolbar: PControl; BtnID1st: Integer; const Tooltips: array of PKOLChar );
|
|
function ToolbarButtonEnabled( Toolbar: PControl; BtnID: Integer ): Boolean;
|
|
function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean;
|
|
procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean );
|
|
procedure EnableToolbarButton( Toolbar: PControl; BtnID: Integer; Enable: Boolean );
|
|
function ToolbarButtonVisible( Toolbar: PControl; BtnID: Integer ): Boolean;
|
|
procedure ShowHideToolbarButton( Toolbar: PControl; BtnID: Integer; Show: Boolean );
|
|
|
|
|
|
function NewProgressbar( AParent: PControl ): PControl;
|
|
function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl;
|
|
|
|
{$IFNDEF TOGRUSH_NO_MESSAGEBOX}
|
|
function MessageBox( Wnd: HWnd; msg, title: PChar; flags: DWORD ): Integer; stdcall;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF TOGRUSH_NO_SCROLLBARS}
|
|
function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl;
|
|
function Scrollbar_GetMinPos( sb: PControl ): Integer;
|
|
procedure Scrollbar_SetMinPos( sb: PControl; m: Integer );
|
|
procedure Scrollbar_SetAll( sb: PControl; min, max, pg, cur: Integer );
|
|
function Scrollbar_GetMaxPos( sb: PControl ): Integer;
|
|
procedure Scrollbar_SetMaxPos( sb: PControl; m: Integer );
|
|
function Scrollbar_GetCurPos( sb: PControl ): Integer;
|
|
procedure Scrollbar_SetCurPos( sb: PControl; newp: Integer );
|
|
procedure Scrollbar_SetPageSz( sb: PControl; psz: Integer );
|
|
function Scrollbar_GetPageSz( sb: PControl ): Integer;
|
|
procedure Scrollbar_SetLineSz( sb: PControl; lnz: Integer );
|
|
function Scrollbar_GetLineSz( sb: PControl ): Integer;
|
|
|
|
{$IFNDEF TOGRUSH_NO_WINDOW_SCROLLBARS}
|
|
procedure OverrideScrollbars( C: PControl );
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF TOGRUSH_NO_COMBO_EDIT}
|
|
function NewComboBox( AParent: PControl; Options: TComboOptions ): PControl;
|
|
function NewEditBox( AParent: PControl; Options: TEditOptions ): PControl;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF TOGRUSH_NO_GRADIENTPANEL}
|
|
function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl;
|
|
function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor;
|
|
Style: TGradientStyle; Layout: TGradientLayout ): PControl;
|
|
{$ENDIF}
|
|
|
|
{$DEFINE ROUND_RADIOITEMS} // if commented, the same as check boxes
|
|
{$DEFINE RED_ACCELERATORS} // if commented, accelerators are drawn using underline as usual
|
|
//{$DEFINE RED_GREEN_ACCELS} // too colored!
|
|
function OwnerDrawMenuItem( var Msg: TMsg; const Menus: array of PMenu;
|
|
var Rslt: Integer): Boolean;
|
|
var MenuHighlight: TColor = clGRushHiLight;
|
|
MenuBackground: TColor = clGRushLighten; //$EBE3DD
|
|
MenuTextColor: TColor = clBlack;
|
|
MenuTextHighlight: TColor = clWhite;
|
|
MenuTextDisabled: TColor = clGray;
|
|
MenuTextDisabSel: TColor = clSilver;
|
|
MenuLine1Color: TColor = clBlack;
|
|
MenuLine2Color: TColor = clGRushLight;
|
|
MenuCheckBoxBkColor: TColor = clWhite;
|
|
MenuCheckBoxBorder: TColor = clBlack;
|
|
MenucheckBoxCheck: TColor = clGRushHiLight;
|
|
MenuAccelColor: TColor = {$IFDEF RED_GREEN_ACCELS} clRed {$ELSE} clBlue {$ENDIF};
|
|
MenuAccelSelColor: TColor = {$IFDEF RED_GREEN_ACCELS} clLime {$ELSE} clNavy {$ENDIF};
|
|
MenuAccelDisabled: TColor = clDkGray;
|
|
MenuAccelSelDisabled: TColor = clDkGray;
|
|
MenuHotKeyTextColor: TColor = {$IFDEF RED_GREEN_ACCELS} clBlue {$ELSE} clGRushHiLight {$ENDIF};
|
|
MenuHotKeySelTxColor: TColor = clNavy;
|
|
MenuHotKeyTxDisabled: TColor = clDkGray;
|
|
MenuHotKeySelTxDisabled: TColor = clDkGray;
|
|
|
|
{ To use OwnerDrawMenuItem:
|
|
1. set OwnerDraw to TRUE for all menu items;
|
|
2. in Form.OnMessage, write following code:
|
|
|
|
function TForm1.KOLForm1Message(var Msg: tagMSG;
|
|
var Rslt: Integer): Boolean;
|
|
begin
|
|
Result := FALSE;
|
|
if (Msg.message = WM_DRAWITEM) or (Msg.message = WM_MEASUREITEM) then
|
|
begin
|
|
Result := OwnerDrawMenuItem( Msg, [ PopupMenu1, PopupMenu2, PopupMenu3, PopupMenu4 ],
|
|
Rslt );
|
|
end
|
|
else .......
|
|
}
|
|
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
var NoGrush: Boolean;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
|
|
function TriangleUpBitmap( Horizontal: Boolean ): PBitmap;
|
|
function TriangleDnBitmap( Horizontal: Boolean ): PBitmap;
|
|
|
|
implementation
|
|
|
|
uses KOLadd;
|
|
|
|
const
|
|
IS_DRDWN = 16;
|
|
type
|
|
PControl_ = ^TControl_;
|
|
TControl_ = object( TControl )
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// BUTTON, CHECK, RADIO CHECK
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
function NewButton( AParent: PControl; const Caption: KOLString ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
Result := Pointer( NewGRushButton( AParent, Caption ).SetSize( 64, 22 ) );
|
|
{$IFDEF USE_FLAGS} include( PControl_( Result ).fFlagsG5, G5_IsButton );
|
|
{$ELSE} PControl_( Result ).fIsButton := TRUE; {$ENDIF}
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else
|
|
begin
|
|
Result := Kol.NewButton( AParent, Caption )
|
|
end
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
Result := Pointer( NewGRushCheckBox( AParent, Caption ).SetSize( 64, 22 ) )
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else
|
|
Result := Kol.NewCheckBox( AParent, Caption )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
Result := Pointer( NewGRushRadioBox( AParent, Caption ).SetSize( 64, 22 ) )
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else
|
|
Result := Kol.NewRadiobox( AParent, Caption )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// PANEL
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
if EdgeStyle >= esTransparent then
|
|
begin
|
|
Result := KOL.NewPanel( AParent, esNone ).SetSize( 64, 64 );
|
|
if EdgeStyle = esTransparent then
|
|
Result.Transparent := TRUE;
|
|
end
|
|
else
|
|
Result := Pointer( NewGRushPanel( AParent ) );
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewPanel( AParent, EdgeStyle )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// SPLITTER
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
Result := Pointer( NewGRushSplitter( AParent, MinSizePrev, MinSizeNext ) );
|
|
Result.Transparent := TRUE;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewSplitter( AParent, MinSizePrev, MinSizeNext )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer;
|
|
EdgeStyle: TEdgeStyle ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
Result := Pointer( NewGRushSplitter( AParent, MinSizePrev, MinSizeNext ) );
|
|
Result.Transparent := TRUE;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewSplitterEx( AParent, MinSizePrev, MinSizeNext, EdgeStyle )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// TOOL BAR
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
type
|
|
TTBButtonEvent = packed Record
|
|
BtnID: DWORD;
|
|
Event: TOnToolbarButtonClick;
|
|
end;
|
|
PTBButtonEvent = ^TTBButtonEvent;
|
|
procedure ToGR_ClickToolbarBtn( Dummy, Sender: PControl );
|
|
var D: DWORD;
|
|
Idx: Integer;
|
|
IsCheck, Checked: Boolean;
|
|
Toolbar: PControl_;
|
|
EventRec: PTBButtonEvent;
|
|
begin
|
|
D := GetProp( Sender.Handle, 'GRBTN' );
|
|
Idx := LoWord( D );
|
|
IsCheck := HiWord( D ) and 2 <> 0;
|
|
Checked := HiWord( D ) and 4 <> 0;
|
|
if IsCheck then
|
|
begin
|
|
Checked := not Checked;
|
|
D := D xor $40000;
|
|
SetProp( Sender.Handle, 'GRBTN', D );
|
|
PGrushControl( Sender ).Checked := Checked;
|
|
end;
|
|
Toolbar := Pointer( Sender.Parent );
|
|
if Assigned( Toolbar.DF.fTBEvents ) and
|
|
(Toolbar.DF.fTBevents.Count > Idx) then
|
|
begin
|
|
EventRec := Toolbar.DF.fTBevents.Items[ Idx ];
|
|
if Assigned( EventRec.Event ) then
|
|
EventRec.Event( Toolbar, EventRec.BtnID );
|
|
end
|
|
else
|
|
{$IFDEF NIL_EVENTS}
|
|
if Assigned( Toolbar.EV.fOnClick ) then
|
|
{$ENDIF}
|
|
begin
|
|
PControl_( Toolbar ).fCurIndex := PControl_( Toolbar ).fChildren.IndexOf( Sender );
|
|
Toolbar.EV.fOnClick( Toolbar );
|
|
end;
|
|
end;
|
|
|
|
procedure ToGR_ButtonMouseMove( Dummy, Sender: PControl; var M: TMouseEventData );
|
|
var P: TPoint;
|
|
M1: TMouseEventData;
|
|
begin
|
|
if Assigned( Sender.Parent.OnMouseMove ) then
|
|
begin
|
|
P := MakePoint( M.X, M.Y );
|
|
P := Sender.Client2Screen( P );
|
|
P := Sender.Parent.Screen2Client( P );
|
|
M1 := M;
|
|
M1.X := P.X;
|
|
M1.Y := P.Y;
|
|
Sender.Parent.OnMouseMove( Sender.Parent, M1 );
|
|
end;
|
|
end;
|
|
|
|
procedure ToGR_ClickToolbarBtnDD( Dummy, Sender: PControl );
|
|
var D: DWORD;
|
|
Idx: Integer;
|
|
Toolbar: PControl_;
|
|
EventRec: PTBButtonEvent;
|
|
begin
|
|
D := GetProp( Sender.Handle, 'GRBTN' );
|
|
Idx := LoWord( D );
|
|
Toolbar := Pointer( Sender.Parent );
|
|
{$IFDEF TOGRUSH_DROPBTN2}
|
|
{$ELSE}
|
|
Toolbar := Pointer( Toolbar.Parent );
|
|
{$ENDIF}
|
|
Toolbar.DF.fTBCurItem := Idx;
|
|
Toolbar.fCurIndex := Idx;
|
|
Toolbar.DF.fTBDropped := TRUE;
|
|
if Assigned( Toolbar.DF.fTBevents ) and
|
|
(Toolbar.DF.fTBevents.Count > Idx) then
|
|
begin
|
|
EventRec := Toolbar.DF.fTBevents.Items[ Idx ];
|
|
Toolbar.DF.fTBCurItem := EventRec.BtnID;
|
|
end;
|
|
if Assigned( Toolbar.EV.fOnDropDown ) then
|
|
begin
|
|
Toolbar.EV.fOnDropDown( Toolbar );
|
|
end
|
|
else
|
|
{$IFDEF NIL_EVENTS}
|
|
if Assigned( Toolbar.EV.fOnClick ) then
|
|
{$ENDIF}
|
|
begin
|
|
Toolbar.EV.fOnClick( Toolbar );
|
|
end;
|
|
Toolbar.DF.fTBDropped := FALSE;
|
|
end;
|
|
|
|
procedure Provide_DIS_images( var B: PBitmap );
|
|
var B2: PBitmap;
|
|
y, y_to, x, c: Integer;
|
|
Src, Dst: PRGBQuad;
|
|
first_pixel: Boolean;
|
|
Transp: DWORD;
|
|
begin
|
|
if (B =nil) or B.Empty then Exit;
|
|
B2 := NewDIBBitmap( B.Width, B.Height * 2, pf32bit );
|
|
TRY
|
|
B.Draw( B2.Canvas.Handle, 0, 0 );
|
|
y_to := B.Height;
|
|
first_pixel := TRUE;
|
|
Transp := 0;
|
|
for y := 0 to B.Height-1 do
|
|
begin
|
|
Src := B2.ScanLine[ y ];
|
|
Dst := B2.ScanLine[ y_to ];
|
|
for x := 0 to B2.Width-1 do
|
|
begin
|
|
if first_pixel then
|
|
Transp := PDWORD( Src )^ and $FFFFFF;
|
|
first_pixel := FALSE;
|
|
if PDWORD( Src )^ and $FFFFFF = Transp then
|
|
PDWORD( Dst )^ := Transp
|
|
else
|
|
begin
|
|
{$IFDEF TOGRUSH_AUTO_DIS_BAL}
|
|
c := (Src.rgbRed * 64 + Src.rgbGreen * 128 + Src.rgbBlue * (128 + 64))
|
|
div 256;
|
|
{$ELSE}
|
|
c := (Src.rgbRed * 64 + Src.rgbGreen * 64 + Src.rgbBlue * 64)
|
|
div 100;
|
|
{$ENDIF}
|
|
if c > 255 then c := 255;
|
|
Dst.rgbBlue := c;
|
|
Dst.rgbGreen := c;
|
|
Dst.rgbRed := c;
|
|
end;
|
|
inc( Src );
|
|
inc( Dst );
|
|
end;
|
|
inc( y_to );
|
|
end;
|
|
FINALLY
|
|
B.Assign( B2 );
|
|
B2.Free;
|
|
END;
|
|
end;
|
|
|
|
var DrDownBmp: PBitmap;
|
|
function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions;
|
|
Bitmap: HBitmap; const Buttons: array of PKOLChar;
|
|
const BtnImgIdxArray: array of Integer ) : PControl;
|
|
var //i, BtnID: Integer;
|
|
//B, B2: PGRushControl;
|
|
{$IFDEF GRAPHCTL_XPSTYLES}
|
|
pb: PControl;
|
|
{$ENDIF}
|
|
//C: String;
|
|
//IsSep: Boolean;
|
|
//IsDropDown: Boolean;
|
|
//IsCheck, Checked, IsRadio: Boolean;
|
|
//Idx: Integer;
|
|
//D: DWORD;
|
|
//imgW, imgH, W,
|
|
H: Integer;
|
|
Bmp: PBitmap;
|
|
//DD_dst: PByte;
|
|
//y: Integer;
|
|
ES: TEdgeStyle;
|
|
const DD_img: array[ 0..6 ] of Byte = ( $0, $F8, $F8, $70, $70, $20, $20 );
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := Kol.NewToolbar( AParent, Align, Options, Bitmap, Buttons, BtnImgIdxArray );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
if Align = caNone then Align := caTop;
|
|
H := 0;
|
|
|
|
//imgW := 0;
|
|
//imgH := 0;
|
|
Bmp := nil;
|
|
if (Bitmap <> 0) and (Bitmap <> THandle( -1 )) then
|
|
begin
|
|
Bmp := NewBitmap( 0, 0 );
|
|
Bmp.Handle := Bitmap;
|
|
//imgH := Bmp.Height;
|
|
//imgW := imgH;
|
|
H := Bmp.Height + 12;
|
|
//Bmp.PixelFormat := pf32bit;
|
|
//Bmp.SaveToFile( GetStartDir + 'test_toolbar1.bmp' );
|
|
{$IFDEF TOGRUSH_AUTO_DISIMAGES}
|
|
Provide_DIS_images( Bmp );
|
|
{$ENDIF}
|
|
end;
|
|
|
|
ES := esNone;
|
|
if ([tboTransparent, tboFlat] * Options <> []) or GRush_Force_Flat_Toolbars then
|
|
begin
|
|
ES := esTransparent;
|
|
{if not( tboTransparent in Options ) then
|
|
ES := esSolid;}
|
|
end;
|
|
Result := Pointer( NewPanel( AParent, ES ).SetSize( 0, H ).SetAlign(Align) );
|
|
ToolbarAddButtons( Result, Buttons, BtnImgIdxArray, Bitmap );
|
|
(*
|
|
Idx := -1;
|
|
for i := 0 to High( Buttons ) do
|
|
begin
|
|
C := Buttons[ i ];
|
|
IsSep := C = '-';
|
|
IsDropDown := FALSE;
|
|
IsCheck := FALSE;
|
|
Checked := FALSE;
|
|
BtnID := i;
|
|
if IsSep then C := ''
|
|
else
|
|
begin
|
|
Inc( Idx );
|
|
IsDropDown := (C <> '') and (C[ 1 ] = '^');
|
|
if IsDropDown then Delete( C, 1, 1 );
|
|
IsCheck := (C <> '') and (C[ 1 ] in [ '+', '-' ]);
|
|
if IsCheck then
|
|
begin
|
|
Checked := C[ 1 ] = '+';
|
|
Delete( C, 1, 1 );
|
|
IsRadio := (C <> '') and (C[ 1 ] = '!');
|
|
if IsRadio then Delete( C, 1, 1 );
|
|
end;
|
|
{$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON}
|
|
if (C <> '') and (C[ 1 ] = '.') then
|
|
Delete( C, 1, 1 );
|
|
{$ENDIF TOOLBAR_DOT_NOAUTOSIZE_BUTTON}
|
|
end;
|
|
if Trim( C ) = '' then C := '';
|
|
if IsSep then
|
|
{$IFDEF GRAPHCTL_XPSTYLES}
|
|
begin
|
|
pb := NewPaintbox( Result ).SetSize( 6, 0 ).SetAlign( caLeft );
|
|
pb.Transparent := TRUE;
|
|
end
|
|
{$ELSE}
|
|
NewPanel( Result, esTransparent ).SetSize( 6, 0 ).SetAlign( caLeft )
|
|
{$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE}
|
|
.MouseTransparent
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
else
|
|
begin
|
|
if C = '' then
|
|
begin
|
|
W := 32;
|
|
if H <> 0 then W := H;
|
|
end
|
|
else
|
|
begin
|
|
W := 64;
|
|
end;
|
|
B := Pointer( NewButton( Result, C ).SetSize( W, 0 ).SetAlign( caLeft ) );
|
|
{$IFDEF USE_NAMES}
|
|
//B.Name := 'TB' + Int2Str( Idx+1 );
|
|
{$ENDIF USE_NAMES}
|
|
B.Tabstop := FALSE;
|
|
B.LikeSpeedButton;
|
|
{$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE}
|
|
B.OnMouseMove := TOnMouse( MakeMethod( nil, @ ToGR_ButtonMouseMove ) );
|
|
{$ENDIF}
|
|
B.Transparent := TRUE;
|
|
if IsSep then B.Enabled := FALSE;
|
|
if B.GetWindowHandle <> 0 then
|
|
begin
|
|
D := i or Integer( IsSep ) shl 16
|
|
or Integer( IsCheck ) shl 17
|
|
or Integer( Checked ) shl 18
|
|
or Integer( IsDropDown ) shl 19
|
|
;
|
|
SetProp( B.Handle, 'GRBTN', D );
|
|
end;
|
|
SetProp( B.Handle, 'BTNID', BtnID );
|
|
B.OnClick := TOnEvent( MakeMethod( nil, @ ToGR_ClickToolbarBtn ) );
|
|
if Bmp <> nil then
|
|
begin
|
|
B.All_GlyphItemX := idx;
|
|
B.All_GlyphItemY := 0;
|
|
B.All_GlyphBitmap := Bmp;
|
|
B.All_GlyphWidth := ImgW;
|
|
B.All_GlyphHeight := ImgH;
|
|
//B.All_GlyphAttached := TRUE;
|
|
{$IFDEF TOGRUSH_AUTO_DISIMAGES}
|
|
B.Dis_GlyphItemX := idx;
|
|
B.Dis_GlyphItemY := 1;
|
|
B.All_GlyphBitmap := Bmp;
|
|
B.All_GlyphWidth := ImgW;
|
|
B.All_GlyphHeight := ImgH;
|
|
{$ENDIF}
|
|
if not IsDropDown and (C = '') then
|
|
B.All_GlyphHAlign := haCenter;
|
|
end;
|
|
{$IFNDEF TOGRUSH_NO_AUTO_SIZE_BTNS}
|
|
B.aAutoSzX := 10 + ImgW;
|
|
if ImgW > 0 then inc( B.aAutoSzX, 5 );
|
|
if IsDropDown then inc( B.aAutoSzX, 10 );
|
|
B.AutoSize( TRUE );
|
|
{$ENDIF}
|
|
if IsDropDown then
|
|
begin
|
|
{$IFDEF TOGRUSH_DROPBTN2}
|
|
B2 := Pointer( NewButton( Result, C ).SetSize( 5 + 8, 0 ).SetAlign( caLeft ) );
|
|
{$ELSE}
|
|
//B.AutoSize( FALSE );
|
|
//B.Width := W + 13;
|
|
B.All_TextHAlign := haLeft;
|
|
B.Border := 2;
|
|
B2 := Pointer( NewButton( B, C ).SetSize( 5 + 8, 0 ).SetAlign( caRight ) );
|
|
{$ENDIF}
|
|
{$IFDEF USE_NAMES}
|
|
//B2.Name := 'TB_dd' + Int2Str( Idx+1 );
|
|
{$ENDIF USE_NAMES}
|
|
B2.Tabstop := FALSE;
|
|
B2.LikeSpeedButton;
|
|
B2.Transparent := TRUE;
|
|
PGrushControl( B2 ).All_BorderWidth := 0;
|
|
PGrushControl( B2 ).Over_BorderWidth := 1;
|
|
if B2.GetWindowHandle <> 0 then
|
|
begin
|
|
D := i or Integer( IsSep ) shl 16
|
|
or Integer( IsCheck ) shl 17
|
|
or Integer( Checked ) shl 18
|
|
or Integer( IsDropDown ) shl 19
|
|
or IS_DRDWN shl 16;
|
|
SetProp( B2.Handle, 'GRBTN', D );
|
|
end;
|
|
B2.OnClick := TOnEvent( MakeMethod( nil, @ ToGR_ClickToolbarBtnDD ) );
|
|
if DrDownBmp = nil then
|
|
begin
|
|
DrDownBmp := NewDIBBitmap( 5, High( DD_img )+1, pf1bit );
|
|
DrDownBmp.DIBPalEntries[ 0 ] := $686868;
|
|
DrDownBmp.DIBPalEntries[ 1 ] := $FFFFFF;
|
|
for y := 0 to High( DD_img ) do
|
|
begin
|
|
DD_dst := DrDownBmp.ScanLine[ y ];
|
|
DD_dst^ := not DD_img[ y ];
|
|
end;
|
|
B2.All_GlyphBitmap := DrDownBmp;
|
|
end
|
|
else
|
|
begin
|
|
B2.All_GlyphBitmap := DrDownBmp;
|
|
end;
|
|
B2.All_GlyphWidth := 5;
|
|
B2.All_GlyphHeight := High( DD_img )+1;
|
|
B2.All_GlyphHAlign := haCenter;
|
|
B2.All_GlyphVAlign := vaBottom;
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
if Bmp <> nil then
|
|
begin
|
|
Bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar;
|
|
const BtnImgIdxArray: array of Integer; Bitmap: HBitmap );
|
|
var i, Idx, BtnID, W, H, ImgH, ImgW, y: Integer;
|
|
IsSep, IsDropDown, IsCheck, Checked, IsRadio: Boolean;
|
|
C: KOLString;
|
|
B, B2: PGrushControl;
|
|
D: DWORD;
|
|
Bmp: PBitmap;
|
|
DD_dst: PByte;
|
|
const DD_img: array[ 0..6 ] of Byte = ( $0, $F8, $F8, $70, $70, $20, $20 );
|
|
begin
|
|
H := 0;
|
|
imgW := 0;
|
|
imgH := 0;
|
|
Bmp := nil;
|
|
if (Bitmap <> 0) and (Bitmap <> THandle( -1 )) then
|
|
begin
|
|
Bmp := NewBitmap( 0, 0 );
|
|
Bmp.Handle := Bitmap;
|
|
imgH := Bmp.Height;
|
|
imgW := imgH;
|
|
H := Bmp.Height + 12;
|
|
{$IFDEF TOGRUSH_AUTO_DISIMAGES}
|
|
Provide_DIS_images( Bmp );
|
|
{$ENDIF}
|
|
end;
|
|
Idx := -1;
|
|
for i := 0 to High( Buttons ) do
|
|
begin
|
|
C := Buttons[ i ];
|
|
IsSep := C = '-';
|
|
IsDropDown := FALSE;
|
|
IsCheck := FALSE;
|
|
Checked := FALSE;
|
|
BtnID := i;
|
|
if IsSep then C := ''
|
|
else
|
|
begin
|
|
Inc( Idx );
|
|
IsDropDown := (C <> '') and (C[ 1 ] = '^');
|
|
if IsDropDown then Delete( C, 1, 1 );
|
|
IsCheck := (C <> '') and CharIn(C[1], [ '+', '-' ]);
|
|
if IsCheck then
|
|
begin
|
|
Checked := C[ 1 ] = '+';
|
|
Delete( C, 1, 1 );
|
|
IsRadio := (C <> '') and (C[ 1 ] = '!');
|
|
if IsRadio then Delete( C, 1, 1 );
|
|
end;
|
|
{$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON}
|
|
if (C <> '') and (C[ 1 ] = '.') then
|
|
Delete( C, 1, 1 );
|
|
{$ENDIF TOOLBAR_DOT_NOAUTOSIZE_BUTTON}
|
|
end;
|
|
if Trim( C ) = '' then C := '';
|
|
if IsSep then
|
|
{$IFDEF GRAPHCTL_XPSTYLES}
|
|
begin
|
|
pb := NewPaintbox( Result ).SetSize( 6, 0 ).SetAlign( caLeft );
|
|
pb.Transparent := TRUE;
|
|
end
|
|
{$ELSE}
|
|
NewPanel( Toolbar, esTransparent ).SetSize( 6, 0 ).SetAlign( caLeft )
|
|
{$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE}
|
|
.MouseTransparent
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
else
|
|
begin
|
|
if C = '' then
|
|
begin
|
|
W := 32;
|
|
if H <> 0 then W := H;
|
|
end
|
|
else
|
|
begin
|
|
W := 64;
|
|
end;
|
|
B := Pointer( NewButton( Toolbar, C ).SetSize( W, 0 ).SetAlign( caLeft ) );
|
|
{$IFDEF USE_NAMES}
|
|
//B.Name := 'TB' + Int2Str( Idx+1 );
|
|
{$ENDIF USE_NAMES}
|
|
B.Tabstop := FALSE;
|
|
B.LikeSpeedButton;
|
|
{$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE}
|
|
B.OnMouseMove := TOnMouse( MakeMethod( nil, @ ToGR_ButtonMouseMove ) );
|
|
{$ENDIF}
|
|
B.Transparent := TRUE;
|
|
if IsSep then B.Enabled := FALSE;
|
|
if B.GetWindowHandle <> 0 then
|
|
begin
|
|
D := i or Integer( IsSep ) shl 16
|
|
or Integer( IsCheck ) shl 17
|
|
or Integer( Checked ) shl 18
|
|
or Integer( IsDropDown ) shl 19
|
|
;
|
|
SetProp( B.Handle, 'GRBTN', D );
|
|
end;
|
|
SetProp( B.Handle, 'BTNID', BtnID );
|
|
B.OnClick := TOnEvent( MakeMethod( nil, @ ToGR_ClickToolbarBtn ) );
|
|
if Bmp <> nil then
|
|
begin
|
|
B.All_GlyphItemX := idx;
|
|
B.All_GlyphItemY := 0;
|
|
B.All_GlyphBitmap := Bmp;
|
|
B.All_GlyphWidth := ImgW;
|
|
B.All_GlyphHeight := ImgH;
|
|
//B.All_GlyphAttached := TRUE;
|
|
{$IFDEF TOGRUSH_AUTO_DISIMAGES}
|
|
B.Dis_GlyphItemX := idx;
|
|
B.Dis_GlyphItemY := 1;
|
|
B.All_GlyphBitmap := Bmp;
|
|
B.All_GlyphWidth := ImgW;
|
|
B.All_GlyphHeight := ImgH;
|
|
{$ENDIF}
|
|
if not IsDropDown and (C = '') then
|
|
B.All_GlyphHAlign := haCenter;
|
|
end;
|
|
{$IFNDEF TOGRUSH_NO_AUTO_SIZE_BTNS}
|
|
B.aAutoSzX := 10 + ImgW;
|
|
if ImgW > 0 then inc( B.aAutoSzX, 5 );
|
|
if IsDropDown then inc( B.aAutoSzX, 10 );
|
|
B.AutoSize( TRUE );
|
|
{$ENDIF}
|
|
if IsDropDown then
|
|
begin
|
|
{$IFDEF TOGRUSH_DROPBTN2}
|
|
B2 := Pointer( NewButton( Result, C ).SetSize( 5 + 8, 0 ).SetAlign( caLeft ) );
|
|
{$ELSE}
|
|
//B.AutoSize( FALSE );
|
|
//B.Width := W + 13;
|
|
B.All_TextHAlign := haLeft;
|
|
B.Border := 2;
|
|
B2 := Pointer( NewButton( B, C ).SetSize( 5 + 8, 0 ).SetAlign( caRight ) );
|
|
{$ENDIF}
|
|
{$IFDEF USE_NAMES}
|
|
//B2.Name := 'TB_dd' + Int2Str( Idx+1 );
|
|
{$ENDIF USE_NAMES}
|
|
B2.Tabstop := FALSE;
|
|
B2.LikeSpeedButton;
|
|
B2.Transparent := TRUE;
|
|
PGrushControl( B2 ).All_BorderWidth := 0;
|
|
PGrushControl( B2 ).Over_BorderWidth := 1;
|
|
if B2.GetWindowHandle <> 0 then
|
|
begin
|
|
D := i or Integer( IsSep ) shl 16
|
|
or Integer( IsCheck ) shl 17
|
|
or Integer( Checked ) shl 18
|
|
or Integer( IsDropDown ) shl 19
|
|
or IS_DRDWN shl 16;
|
|
SetProp( B2.Handle, 'GRBTN', D );
|
|
end;
|
|
B2.OnClick := TOnEvent( MakeMethod( nil, @ ToGR_ClickToolbarBtnDD ) );
|
|
if DrDownBmp = nil then
|
|
begin
|
|
DrDownBmp := NewDIBBitmap( 5, High( DD_img )+1, pf1bit );
|
|
DrDownBmp.DIBPalEntries[ 0 ] := $686868;
|
|
DrDownBmp.DIBPalEntries[ 1 ] := $FFFFFF;
|
|
for y := 0 to High( DD_img ) do
|
|
begin
|
|
DD_dst := DrDownBmp.ScanLine[ y ];
|
|
DD_dst^ := not DD_img[ y ];
|
|
end;
|
|
B2.All_GlyphBitmap := DrDownBmp;
|
|
end
|
|
else
|
|
begin
|
|
B2.All_GlyphBitmap := DrDownBmp;
|
|
end;
|
|
B2.All_GlyphWidth := 5;
|
|
B2.All_GlyphHeight := High( DD_img )+1;
|
|
B2.All_GlyphHAlign := haCenter;
|
|
B2.All_GlyphVAlign := vaBottom;
|
|
end;
|
|
end;
|
|
end;
|
|
if Bmp <> nil then
|
|
Bmp.Free;
|
|
end;
|
|
|
|
function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect;
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := Kol.ToolbarButtonRect( Toolbar, BtnID );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
Result := B.BoundsRect;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := MakeRect( 0, 0, 0, 0 );
|
|
end;
|
|
|
|
procedure ToolbarSetTooltips( Toolbar: PControl; BtnID1st: Integer; const Tooltips: array of PKOLChar );
|
|
{$IFDEF USE_MHTOOLTIP}
|
|
var i, j: Integer;
|
|
B: PControl;
|
|
found: Boolean;
|
|
{$ENDIF}
|
|
begin
|
|
Toolbar.TBSetTooltips( BtnID1st, Tooltips );
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then Exit;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
{$IFDEF USE_MHTOOLTIP}
|
|
found := FALSE;
|
|
j := 0;
|
|
if BtnID1st < 0 then BtnID1st := 0;
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
if j > High( Tooltips ) then break;
|
|
B := Toolbar.Children[ i ];
|
|
//if not B.IsButton then continue;
|
|
if HiWord( GetProp( B.Handle, 'GRBTN' ) ) and IS_DRDWN <> 0 then
|
|
continue;
|
|
if found or (Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID1st) then
|
|
begin
|
|
found := TRUE;
|
|
if Trim( Tooltips[ j ] ) <> '' then
|
|
NewHint( B ).Text := Tooltips[ j ];
|
|
inc( BtnID1st );
|
|
inc( j );
|
|
end;
|
|
end;
|
|
{$ENDIF USE_MHTOOLTIP}
|
|
end;
|
|
|
|
function ToolbarButtonEnabled( Toolbar: PControl; BtnID: Integer ): Boolean;
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := Kol.ToolbarButtonEnabled( Toolbar, BtnID );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
Result := B.Enabled;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := FALSE;
|
|
end;
|
|
|
|
function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean;
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := Toolbar.TBButtonChecked[ BtnID ];
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
Result := B.Checked;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := FALSE;
|
|
end;
|
|
|
|
procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean );
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Toolbar.TBButtonChecked[ BtnID ] := Checked;
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
B.Checked := Checked;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure EnableToolbarButton( Toolbar: PControl; BtnID: Integer; Enable: Boolean );
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Kol.EnableToolbarButton( Toolbar, BtnID, Enable );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
B.Enabled := Enable;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ToolbarButtonVisible( Toolbar: PControl; BtnID: Integer ): Boolean;
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := Kol.ToolbarButtonVisible( Toolbar, BtnID );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
Result := B.Visible;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := FALSE;
|
|
end;
|
|
|
|
procedure ShowHideToolbarButton( Toolbar: PControl; BtnID: Integer; Show: Boolean );
|
|
var i: Integer;
|
|
B: PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Kol.ShowHideToolbarButton( Toolbar, BtnID, Show );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
for i := 0 to Toolbar.ChildCount-1 do
|
|
begin
|
|
B := Toolbar.Children[ i ];
|
|
if (B.GetWindowHandle <> 0) and
|
|
(Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then
|
|
begin
|
|
B.Visible := Show;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// PROGRESS BAR
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
function NewProgressbar( AParent: PControl ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
Result := Pointer( NewGRushProgressBar( AParent ).SetSize( 300, 20 ) );
|
|
PGRushControl( Result ).Def_BorderRoundWidth := 10;
|
|
PGRushControl( Result ).Def_BorderRoundHeight := 10;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else
|
|
Result := Kol.NewProgressbar( AParent )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
Result := NewProgressbar( AParent )
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else
|
|
Result := Kol.NewProgressbarEx( AParent, Options );
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// MessageBox replacement
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
{$IFNDEF TOGRUSH_NO_MESSAGEBOX}
|
|
function MessageBox( Wnd: HWnd; msg, title: PChar; flags: DWORD ): Integer; stdcall;
|
|
var Answers: String;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := Windows.MessageBox( Wnd, msg, title, flags );
|
|
Exit;
|
|
end;
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
CASE flags and 7 OF
|
|
MB_OK : Answers := 'OK';
|
|
MB_OKCANCEL : Answers := 'OK/Cancel';
|
|
MB_ABORTRETRYIGNORE : Answers := 'Abort/Retry/Ignore';
|
|
MB_YESNOCANCEL : Answers := 'Yes/No/Cancel';
|
|
MB_YESNO : Answers := 'Yes/No';
|
|
MB_RETRYCANCEL : Answers := 'Retry/Cancel';
|
|
END;
|
|
Result := ShowQuestionEx( msg, Answers, nil );
|
|
CASE flags and 7 OF
|
|
MB_OK : Result := ID_OK;
|
|
MB_OKCANCEL : if Result <> ID_OK then Result := ID_CANCEL;
|
|
MB_ABORTRETRYIGNORE : CASE Result OF
|
|
1: Result := ID_ABORT;
|
|
2: Result := ID_RETRY;
|
|
else Result := ID_IGNORE;
|
|
END;
|
|
MB_YESNOCANCEL : CASE Result OF
|
|
1: Result := ID_YES;
|
|
2: Result := ID_NO;
|
|
else Result := ID_CANCEL;
|
|
END;
|
|
MB_YESNO : CASE Result OF
|
|
1: Result := ID_YES;
|
|
else Result := ID_NO;
|
|
END;
|
|
MB_RETRYCANCEL : CASE Result OF
|
|
1: Result := ID_RETRY;
|
|
else Result := ID_CANCEL;
|
|
END;
|
|
else Result := 0;
|
|
END;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
var SBBrush: HBrush;
|
|
function WndProc_RecolorScrollbars( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
|
|
//var OldPaintDC: HDC;
|
|
begin
|
|
Result := FALSE;
|
|
CASE M.message OF
|
|
WM_CTLCOLORSCROLLBAR:
|
|
begin
|
|
//SetBkColor( M.wParam, clGRushLighten );
|
|
if SBBrush = 0 then
|
|
SBBrush := CreateSolidBrush( ColorsMix( clGRushLighten, clGRushLight ) );
|
|
Rslt := SBBrush;
|
|
Result := TRUE;
|
|
end;
|
|
{WM_PAINT, WM_PRINT, WM_NCPAINT:
|
|
begin
|
|
Rslt := 0;
|
|
Result := TRUE;
|
|
end;}
|
|
END;
|
|
end;
|
|
|
|
{$IFNDEF TOGRUSH_NO_SCROLLBARS}
|
|
type PSBObj = ^TSBObj;
|
|
TSBObj = object( TObj )
|
|
sbar: PControl;
|
|
orientation: TScrollerBar;
|
|
b_up, b_dn, thumb: PGRushControl;
|
|
minpos, maxpos, oldpos, curpos: Integer;
|
|
pagesz, linesz: Integer;
|
|
Timer: PTimer;
|
|
how_scroll_by_timer, cmd_timer: Integer;
|
|
th_click_mouse, th_delta: Integer;
|
|
th_click_curpos: Integer;
|
|
th_clicked: Boolean;
|
|
procedure Init; virtual;
|
|
destructor Destroy; virtual;
|
|
procedure Adjust;
|
|
procedure Resized( Sender: PObj );
|
|
procedure UpClick( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure DnClick( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure ThumbClick( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure ThumbTrack( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure TimerOff( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure Release_Capture( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure Scrolled( cmd: Integer );
|
|
procedure ScrollByTimer( Sender: PObj );
|
|
function WndProc( var M: TMsg; var Rslt: Integer ): Boolean;
|
|
end;
|
|
|
|
function WndProcScrollbar( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
|
|
var SBObj: PSBObj;
|
|
begin
|
|
SBObj := Pointer( Sender.CustomObj );
|
|
Result := SBObj.WndProc( M, Rslt );
|
|
end;
|
|
|
|
function TriangleBitmap( const PtsVert, PtsHorz: array of Integer; Horizontal: Boolean ): PBitmap;
|
|
type TIntArray = array[0..100] of Integer;
|
|
PIntArray = ^TIntArray;
|
|
var Pts: PIntArray;
|
|
begin
|
|
Result := NewDIBBitmap( 8, 8, pf1bit );
|
|
Result.DIBPalEntries[ 1 ] := $FFFFFF;
|
|
Result.Canvas.Brush.Color := clWhite;
|
|
Result.Canvas.FillRect( Result.BoundsRect );
|
|
if Horizontal then Pts := Pointer( @ PtsHorz[ 0 ] )
|
|
else Pts := Pointer( @ PtsVert[ 0 ] );
|
|
Result.Canvas.Brush.Color := clBlack;
|
|
Result.Canvas.Polygon( [ MakePoint( Pts[0],Pts[1] ),
|
|
MakePoint( Pts[2],Pts[3] ),
|
|
MakePoint( Pts[4],Pts[5] ),
|
|
MakePoint( Pts[6],Pts[7] ) ] );
|
|
end;
|
|
|
|
function TriangleUpBitmap( Horizontal: Boolean ): PBitmap;
|
|
begin
|
|
Result := TriangleBitmap( [ 0,5, 3,2, 4,2, 7,5 ],
|
|
[ 5,0, 2,3, 2,4, 5,7 ], Horizontal );
|
|
end;
|
|
|
|
function TriangleDnBitmap( Horizontal: Boolean ): PBitmap;
|
|
begin
|
|
Result := TriangleBitmap( [ 0,2, 3,5, 4,5, 7,2 ],
|
|
[ 2,0, 5,3, 5,4, 2,7 ], Horizontal );
|
|
end;
|
|
|
|
function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl;
|
|
var SBObj: PSBObj;
|
|
W, H: Integer;
|
|
Bup, Bdn, Bth: PBitmap;
|
|
R: TRect;
|
|
|
|
procedure FillThumbBmp( x, y: Integer );
|
|
var i, dx, dy: Integer;
|
|
begin
|
|
dx := 0;
|
|
dy := 0;
|
|
if BarSide = sbHorizontal then dx := 1
|
|
else dy := 1;
|
|
for i := 1 to 4 do
|
|
begin
|
|
Bth.Canvas.MoveTo( x, y );
|
|
Bth.Canvas.LineTo( x + dy * 8, y + dx * 8 );
|
|
inc( x, dx * 2 );
|
|
inc( y, dy * 2 );
|
|
end;
|
|
end;
|
|
|
|
var A: TControlAlign;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
{Result := KOL.NewScrollBar(AParent, BarSide);
|
|
AParent.AttachProc( @ WndProc_RecolorScrollbars );}
|
|
W := GetSystemMetrics( SM_CXVSCROLL );
|
|
H := GetSystemMetrics( SM_CYHSCROLL );
|
|
Result := KOL.NewPanel( AParent, esNone );
|
|
Result.Border := 0;
|
|
Result.Color := ColorsMix( clGRushLighten, clGRushLight );
|
|
if BarSide = sbHorizontal then
|
|
Result.SetSize( 0, W )
|
|
else
|
|
Result.SetSize( H, 0 );
|
|
new( SBObj, Create );
|
|
Result.CustomObj := SBObj;
|
|
SBObj.sbar := Result;
|
|
SBObj.orientation := BarSide;
|
|
SBObj.maxpos := 100;
|
|
SBObj.pagesz := 1;
|
|
SBObj.linesz := 1;
|
|
SBObj.b_up := NewGRushButton( Result, '' );
|
|
A := caTop; if BarSide = sbHorizontal then A := caLeft;
|
|
SBObj.b_up.SetSize( W, H ).SetAlign( A ).LikeSpeedButton;
|
|
SBObj.b_dn := NewGRushButton( Result, '' );
|
|
A := caBottom; if BarSide = sbHorizontal then A := caRight;
|
|
SBObj.b_dn.SetSize( W, H ).SetAlign( A ).LikeSpeedButton;
|
|
SBObj.thumb := NewGRushButton( Result, '' );
|
|
SBObj.thumb.SetSize( W, H ).LikeSpeedButton;
|
|
Bup := TriangleUpBitmap( BarSide = sbHorizontal );
|
|
Bdn := TriangleDnBitmap( BarSide = sbHorizontal );
|
|
Bth := NewDIBBitmap( 10, 10, pf32bit );
|
|
Bth.Canvas.Pen.Color := SBObj.b_up.Def_ColorFrom;
|
|
FillThumbBmp( 1, 1 );
|
|
Bth.Canvas.Pen.Color := SBObj.b_up.Def_ColorTo;
|
|
FillThumbBmp( 2, 2 );
|
|
|
|
Result.OnResize := SBObj.Resized;
|
|
|
|
SBObj.b_up.All_GlyphBitmap := Bup; Bup.Free;
|
|
SBObj.b_up.All_GlyphHAlign := haCenter;
|
|
SBObj.b_dn.All_GlyphBitmap := Bdn; Bdn.Free;
|
|
SBObj.b_dn.All_GlyphHAlign := haCenter;
|
|
SBObj.thumb.All_GlyphBitmap := Bth; Bth.Free;
|
|
SBObj.thumb.All_GlyphHAlign := haCenter;
|
|
//SBObj.thumb.All_ContentOffsets := MakeRect( -1, -1, 1, 1 );
|
|
R := MakeRect( 1, 1, -1, -1 );
|
|
SBObj.b_up.All_ContentOffsets := R;
|
|
SBObj.b_dn.All_ContentOffsets := R;
|
|
SBObj.thumb.All_ContentOffsets := R;
|
|
if BarSide = sbHorizontal then SBObj.thumb.Left := W
|
|
else SBObj.thumb.Top := H;
|
|
|
|
SBObj.b_up.OnMouseDown := SBObj.UpClick;
|
|
SBObj.b_dn.OnMouseDown := SBObj.DnClick;
|
|
SBObj.thumb.OnMouseDown := SBObj.ThumbClick;
|
|
SBObj.b_up.OnMouseUp := SBObj.TimerOff;
|
|
SBObj.b_dn.OnMouseUp := SBObj.TimerOff;
|
|
SBObj.thumb.OnMouseUp := SBObj.Release_Capture;
|
|
SBObj.thumb.OnMouseMove := SBObj.ThumbTrack;
|
|
Result.AttachProc( WndProcScrollbar );
|
|
SBObj.Timer := NewTimer( 400 );
|
|
SBObj.Timer.OnTimer := SBObj.ScrollByTimer;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewScrollBar( AParent, BarSide )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
function Scrollbar_GetMinPos( sb: PControl ): Integer;
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
Result := sb.SBMin;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
Result := SBObj.minpos;
|
|
end;
|
|
|
|
procedure Scrollbar_SetMinPos( sb: PControl; m: Integer );
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
sb.SBMin := m;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
SBObj.minpos := m;
|
|
SBObj.Adjust;
|
|
end;
|
|
|
|
procedure Scrollbar_SetAll( sb: PControl; min, max, pg, cur: Integer );
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
sb.SBMin := min;
|
|
sb.SBMax := max;
|
|
sb.SBPageSize := pg;
|
|
sb.SBPosition := cur;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
SBObj.minpos := min;
|
|
SBObj.maxpos := max;
|
|
SBObj.pagesz := pg;
|
|
SBObj.curpos := cur;
|
|
SBObj.Adjust;
|
|
end;
|
|
|
|
procedure Scrollbar_SetMaxPos( sb: PControl; m: Integer );
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
sb.SBMax := m;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
SBObj.maxpos := m;
|
|
SBObj.Adjust;
|
|
end;
|
|
|
|
function Scrollbar_GetMaxPos( sb: PControl ): Integer;
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := sb.SBMax;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
Result := SBObj.maxpos;
|
|
end;
|
|
|
|
function Scrollbar_GetCurPos( sb: PControl ): Integer;
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then
|
|
begin
|
|
Result := sb.SBPosition;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
if SBObj <> nil then
|
|
Result := SBObj.curpos
|
|
else Result := 0;
|
|
end;
|
|
|
|
procedure Scrollbar_SetCurPos( sb: PControl; newp: Integer );
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
sb.SBPosition := newp;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
SBObj.curpos := newp;
|
|
SBObj.Adjust;
|
|
end;
|
|
|
|
procedure Scrollbar_SetPageSz( sb: PControl; psz: Integer );
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
sb.SBPageSize := psz;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
SBObj.pagesz := psz;
|
|
SBObj.Adjust;
|
|
end;
|
|
|
|
function Scrollbar_GetPageSz( sb: PControl ): Integer;
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
Result := sb.SBPageSize;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
Result := SBObj.pagesz;
|
|
end;
|
|
|
|
procedure Scrollbar_SetLineSz( sb: PControl; lnz: Integer );
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
SBObj.linesz := lnz;
|
|
end;
|
|
|
|
function Scrollbar_GetLineSz( sb: PControl ): Integer;
|
|
var SBObj: PSBObj;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGRush then
|
|
begin
|
|
Result := 1;
|
|
Exit;
|
|
end;
|
|
{$ENDIF}
|
|
SBObj := Pointer( sb.CustomObj );
|
|
Result := SBObj.linesz;
|
|
end;
|
|
|
|
{ TSBObj }
|
|
|
|
procedure TSBObj.Init;
|
|
begin
|
|
|
|
end;
|
|
|
|
destructor TSBObj.Destroy;
|
|
begin
|
|
Timer.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSBObj.Adjust;
|
|
var total_sz, side_sz, button_sz, thumb_sz, thumb_pos, min_thumb: Integer;
|
|
R: TRect;
|
|
|
|
procedure ProvideWindow( ctl: PControl );
|
|
begin
|
|
if {(ctl.Handle = 0) and} (ctl.Width > 0) and (ctl.Height > 0) then
|
|
begin
|
|
ctl.Visible := TRUE;
|
|
ctl.CreateWindow;
|
|
end
|
|
else
|
|
ctl.Visible := FALSE;
|
|
end;
|
|
begin
|
|
if orientation = sbHorizontal then
|
|
begin
|
|
total_sz := min( sbar.Width, sbar.Parent.Width );
|
|
side_sz := min( sbar.Height, sbar.Parent.Height );
|
|
end
|
|
else
|
|
begin
|
|
total_sz := min( sbar.Height, sbar.Parent.Height );
|
|
side_sz := min( sbar.Width, sbar.Parent.Width );
|
|
end;
|
|
min_thumb := Max( 4, Min( 8, side_sz ) );
|
|
if total_sz - min_thumb >= 2 * side_sz then
|
|
begin
|
|
button_sz := side_sz;
|
|
dec( total_sz, 2 * side_sz );
|
|
end
|
|
else
|
|
begin
|
|
button_sz := total_sz div 2;
|
|
total_sz := 0;
|
|
end;
|
|
if (total_sz > 8) and (maxpos > minpos) then
|
|
begin
|
|
if minpos < maxpos then
|
|
begin
|
|
thumb_sz := Round( pagesz * total_sz /
|
|
(maxpos - minpos + pagesz) );
|
|
if (thumb_sz < side_sz) and
|
|
((total_sz - side_sz) * 10 div (maxpos - minpos) > 1) then
|
|
thumb_sz := side_sz;
|
|
if thumb_sz < min_thumb then thumb_sz := min_thumb;
|
|
end
|
|
else
|
|
thumb_sz := side_sz;
|
|
if thumb_sz > total_sz then
|
|
thumb_sz := total_sz;
|
|
dec( total_sz, thumb_sz );
|
|
end
|
|
else thumb_sz := 0;
|
|
if total_sz > 0 then
|
|
begin
|
|
if minpos < maxpos then
|
|
thumb_pos := (total_sz{-1}) * (curpos - minpos) div (maxpos - minpos)
|
|
else thumb_pos := 0;
|
|
end
|
|
else thumb_pos := 0;
|
|
if orientation = sbHorizontal then
|
|
begin
|
|
b_up.BoundsRect := MakeRect( 0, 0, button_sz, side_sz );
|
|
b_dn.BoundsRect := MakeRect( sbar.Width - button_sz, 0, sbar.Width, side_sz );
|
|
R := MakeRect( button_sz + thumb_pos, 0,
|
|
button_sz + thumb_pos + thumb_sz, side_sz );
|
|
end
|
|
else
|
|
begin
|
|
b_up.BoundsRect := MakeRect( 0, 0, side_sz, button_sz );
|
|
b_dn.BoundsRect := MakeRect( 0, sbar.Height - button_sz, side_sz, sbar.Height );
|
|
R := MakeRect( 0, button_sz + thumb_pos, side_sz,
|
|
button_sz + thumb_pos + thumb_sz );
|
|
end;
|
|
if not RectsEqual( R, thumb.BoundsRect ) then
|
|
begin
|
|
thumb.BoundsRect := R;
|
|
if Assigned( sbar.OnSBScroll ) then
|
|
sbar.OnSBScroll( sbar, SB_THUMBTRACK );
|
|
end;
|
|
ProvideWindow( b_up );
|
|
ProvideWindow( b_dn );
|
|
ProvideWindow( thumb );
|
|
sbar.Update;
|
|
end;
|
|
|
|
procedure TSBObj.DnClick(Sender: PControl; var Mouse: TMouseEventData);
|
|
begin
|
|
how_scroll_by_timer := linesz;
|
|
cmd_timer := SB_LINERIGHT;
|
|
ScrollByTimer( nil );
|
|
Timer.Interval := 400;
|
|
Timer.Enabled := TRUE;
|
|
end;
|
|
|
|
procedure TSBObj.Release_Capture( Sender: PControl; var Mouse: TMouseEventData );
|
|
begin
|
|
th_clicked := FALSE;
|
|
ReleaseCapture;
|
|
end;
|
|
|
|
procedure TSBObj.Resized(Sender: PObj);
|
|
begin
|
|
Adjust;
|
|
end;
|
|
|
|
procedure TSBObj.ScrollByTimer(Sender: PObj);
|
|
begin
|
|
oldpos := curpos;
|
|
inc( curpos, how_scroll_by_timer );
|
|
if curpos < minpos then curpos := minpos;
|
|
if curpos > maxpos then curpos := maxpos;
|
|
Adjust;
|
|
Scrolled( cmd_timer );
|
|
Timer.Interval := 100;
|
|
end;
|
|
|
|
procedure TSBObj.Scrolled( cmd: Integer );
|
|
var Allow: Boolean;
|
|
begin
|
|
Allow := TRUE;
|
|
if Assigned( sbar.OnSBBeforeScroll ) then
|
|
sbar.OnSBBeforeScroll( sbar, oldpos, curpos, cmd, Allow );
|
|
if Assigned( sbar.OnSBScroll ) then
|
|
sbar.OnSBScroll( sbar, cmd )
|
|
else
|
|
if Assigned( sbar.OnScroll ) then
|
|
sbar.OnScroll( sbar, orientation, cmd, curpos );
|
|
end;
|
|
|
|
procedure TSBObj.ThumbClick(Sender: PControl; var Mouse: TMouseEventData);
|
|
var P: TPoint;
|
|
begin
|
|
SetCapture( thumb.Handle );
|
|
th_clicked := TRUE;
|
|
P := thumb.Client2Screen( MakePoint( Mouse.X, Mouse.Y ) );
|
|
if orientation = sbHorizontal then
|
|
begin
|
|
th_click_mouse := P.X;
|
|
th_delta := -Mouse.X;
|
|
end
|
|
else
|
|
begin
|
|
th_click_mouse := P.Y;
|
|
th_delta := -Mouse.Y;
|
|
end;
|
|
th_click_curpos := curpos
|
|
end;
|
|
|
|
procedure TSBObj.ThumbTrack(Sender: PControl; var Mouse: TMouseEventData);
|
|
var new_pos, new_top, total_sz, button_sz, thumb_sz: Integer;
|
|
P: TPoint;
|
|
begin
|
|
if not th_clicked then Exit;
|
|
oldpos := curpos;
|
|
P := Sender.Client2Screen( MakePoint( Mouse.X, Mouse.Y ) );
|
|
P := sbar.Screen2Client(P);
|
|
if orientation = sbHorizontal then
|
|
begin
|
|
new_top := P.X;
|
|
button_sz := b_up.Width;
|
|
thumb_sz := thumb.Width;
|
|
total_sz := sbar.Width;
|
|
end
|
|
else
|
|
begin
|
|
new_top := P.Y;
|
|
button_sz := b_up.Height;
|
|
thumb_sz := thumb.Height;
|
|
total_sz := sbar.Height;
|
|
end;
|
|
new_top := new_top - button_sz + th_delta;
|
|
dec( total_sz, 2 * button_sz + thumb_sz );
|
|
if total_sz > 0 then
|
|
new_pos := minpos + (maxpos - minpos) * new_top div total_sz
|
|
else
|
|
new_pos := 0;
|
|
if new_pos < minpos then new_pos := minpos;
|
|
if new_pos > maxpos then new_pos := maxpos;
|
|
curpos := new_pos;
|
|
Adjust;
|
|
Scrolled( SB_THUMBTRACK );
|
|
end;
|
|
|
|
procedure TSBObj.TimerOff(Sender: PControl; var Mouse: TMouseEventData);
|
|
begin
|
|
Timer.Enabled := FALSE;
|
|
end;
|
|
|
|
procedure TSBObj.UpClick(Sender: PControl; var Mouse: TMouseEventData);
|
|
begin
|
|
how_scroll_by_timer := -linesz;
|
|
cmd_timer := SB_LINELEFT;
|
|
ScrollByTimer( nil );
|
|
Timer.Interval := 400;
|
|
Timer.Enabled := TRUE;
|
|
end;
|
|
|
|
function TSBObj.WndProc(var M: TMsg; var Rslt: Integer): Boolean;
|
|
var X, Y: Integer;
|
|
procedure CalcScrollDirAndStep;
|
|
begin
|
|
how_scroll_by_timer := 0;
|
|
if orientation = sbHorizontal then
|
|
begin
|
|
X := SmallInt( LoWord( M.lParam ) );
|
|
if X < thumb.Left then
|
|
how_scroll_by_timer := -pagesz
|
|
else
|
|
if X > thumb.Left + thumb.Width then
|
|
how_scroll_by_timer := pagesz
|
|
else Exit;
|
|
end
|
|
else
|
|
begin
|
|
Y := SmallInt( HiWord( M.lParam ) );
|
|
if Y < thumb.Top then
|
|
how_scroll_by_timer := -pagesz
|
|
else
|
|
if Y > thumb.Top + thumb.Height then
|
|
how_scroll_by_timer := pagesz
|
|
else Exit;
|
|
end;
|
|
|
|
if how_scroll_by_timer < 0 then
|
|
cmd_timer := SB_PAGELEFT
|
|
else
|
|
cmd_timer := SB_PAGERIGHT;
|
|
end;
|
|
begin
|
|
Result := FALSE;
|
|
CASE M.message OF
|
|
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
|
|
begin
|
|
CalcScrollDirAndStep;
|
|
if (how_scroll_by_timer = 0) then Exit;
|
|
|
|
SetCapture( sbar.Handle );
|
|
ScrollByTimer( nil );
|
|
Timer.Interval := 400;
|
|
Timer.Enabled := TRUE;
|
|
end;
|
|
WM_LBUTTONUP:
|
|
begin
|
|
ReleaseCapture;
|
|
Timer.Enabled := FALSE;
|
|
end;
|
|
WM_MOUSEMOVE:
|
|
begin
|
|
if (Timer <> nil) and Timer.Enabled then
|
|
CalcScrollDirAndStep;
|
|
end;
|
|
END;
|
|
end;
|
|
|
|
type
|
|
POverrideScrollbars = ^TOverrideScrollbars;
|
|
TOverrideScrollbars = object( TObj )
|
|
Handling: Boolean;
|
|
Added2List: Boolean;
|
|
VBar, HBar, Grip: PControl;
|
|
Control2Override: PControl;
|
|
procedure ReplacedScrollBar2Original( Sender: PControl; Cmd: Word );
|
|
destructor Destroy; virtual;
|
|
procedure PaintGrip( Sender: PControl; DC: HDC );
|
|
end;
|
|
|
|
var ListOfOverridenSBars: PList;
|
|
|
|
{ TOverrideScrollbars }
|
|
|
|
destructor TOverrideScrollbars.Destroy;
|
|
begin
|
|
Control2Override.CustomObj := nil; //?
|
|
if Added2List then
|
|
begin
|
|
ListOfOverridenSBars.Remove( Control2Override );
|
|
if ListOfOverridenSBars.Count = 0 then
|
|
begin
|
|
KillTimer( 0, ListOfOverridenSBars.Tag );
|
|
Free_And_Nil( ListOfOverridenSBars );
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TOverrideScrollbars.PaintGrip(Sender: PControl; DC: HDC);
|
|
var R: TRect;
|
|
P: TPoint;
|
|
F: PControl;
|
|
i, j: Integer;
|
|
C: PCanvas;
|
|
begin
|
|
R := Sender.ClientRect;
|
|
C := Sender.Canvas;
|
|
C.FillRect( R );
|
|
P := MakePoint( R.Right, R.Bottom );
|
|
P := Sender.Client2Screen( P );
|
|
F := Sender.ParentForm;
|
|
P := F.Screen2Client( P );
|
|
if (F.ClientWidth - P.X < 16) and
|
|
(F.ClientHeight - P.Y < 16) then
|
|
begin
|
|
for j := 0 to 1 do
|
|
begin
|
|
C.Pen.Color := clWhite;
|
|
if j = 1 then
|
|
C.Pen.Color := clGRushDark;
|
|
for i := 0 to 4 do
|
|
begin
|
|
C.MoveTo( 2+j+i*3, R.Bottom-2 );
|
|
C.LineTo( R.Right-2, 2+j+i*3 );
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOverrideScrollbars.ReplacedScrollBar2Original(Sender: PControl;
|
|
Cmd: Word);
|
|
var O: POverrideScrollbars;
|
|
Ctl: PControl;
|
|
Msg: DWORD;
|
|
CmdF: DWORD;
|
|
Wnd: HWnd;
|
|
var SI: TScrollInfo;
|
|
Bar: Integer;
|
|
NewPos: Integer;
|
|
i, MaxI: Integer;
|
|
Frozen: Boolean;
|
|
begin
|
|
Ctl := Pointer( Sender.Tag );
|
|
O := Pointer( Ctl.CustomObj );
|
|
if O.HBar = Sender then Msg := WM_HSCROLL
|
|
else Msg := WM_VSCROLL;
|
|
{CASE Cmd OF
|
|
SB_LINEUP,
|
|
SB_LINEDOWN,
|
|
SB_THUMBTRACK:
|
|
Cmd := SB_THUMBPOSITION;
|
|
END;}
|
|
CmdF := Cmd;
|
|
NewPos := Scrollbar_GetCurPos( Sender );
|
|
CASE Cmd OF
|
|
SB_THUMBTRACK, SB_THUMBPOSITION:
|
|
CmdF := Cmd or (NewPos shl 16);
|
|
END;
|
|
if not O.Handling then
|
|
begin
|
|
O.Handling := TRUE;
|
|
Frozen := FALSE;
|
|
TRY
|
|
Wnd := Ctl.Handle;
|
|
// � ������, ���� �� ������� � �������� ��������� �������, �� ���
|
|
// �������, ������� �� �������� ������� WM_xSCROLL � SB_THUMBXXXX
|
|
// (ListView). ����� ������� ���������������� ����� ��� ����������
|
|
// ����������������� ��������� SB_LINEUP / SB_LINEDOWN
|
|
i := 0;
|
|
MaxI := 10;
|
|
while i < MaxI do
|
|
begin
|
|
inc( i );
|
|
SI.cbSize := Sizeof( SI );
|
|
SI.fMask := SIF_PAGE or SIF_POS or SIF_RANGE or SIF_TRACKPOS;
|
|
if O.HBar = Sender then Bar := SB_HORZ
|
|
else Bar := SB_VERT;
|
|
GetScrollInfo( Wnd, Bar, SI );
|
|
MaxI := max( MaxI, DWORD(SI.nMax - SI.nMin) div (SI.nPage + 1) );
|
|
if (SI.nPos = NewPos) or
|
|
(SI.nPos < NewPos) and (CmdF = SB_LINEUP) or
|
|
(SI.nPos > NewPos) and (CmdF = SB_LINEDOWN) then break;
|
|
SendMessage( Wnd, Msg, CmdF, 0 );
|
|
if SI.nPos < NewPos then CmdF := SB_LINEDOWN
|
|
else CmdF := SB_LINEUP;
|
|
if DWORD( Abs( SI.nPos - NewPos ) ) > SI.nPage then
|
|
begin
|
|
if SI.nPos < NewPos then CmdF := SB_PAGEDOWN
|
|
else CmdF := SB_PAGEUP;
|
|
if not Frozen then
|
|
begin
|
|
Ctl.BeginUpdate;
|
|
Frozen := TRUE;
|
|
end;
|
|
end
|
|
else
|
|
if Frozen then
|
|
begin
|
|
Frozen := FALSE;
|
|
Ctl.EndUpdate;
|
|
end;
|
|
end;
|
|
FINALLY
|
|
O.Handling := FALSE;
|
|
if Frozen then
|
|
Ctl.EndUpdate;
|
|
END;
|
|
end;
|
|
end;
|
|
|
|
procedure WindowScrollbar2GrushScrollbar( Ctl: PControl; SBar: PControl; Bar: DWORD );
|
|
var SI: TScrollInfo;
|
|
Wnd: HWnd;
|
|
begin
|
|
SI.cbSize := Sizeof( SI );
|
|
SI.fMask := SIF_PAGE or SIF_POS or SIF_RANGE or SIF_TRACKPOS;
|
|
Wnd := Ctl.Handle;
|
|
GetScrollInfo( Wnd, Bar, SI );
|
|
Scrollbar_SetAll( SBar, SI.nMin, SI.nMax - Integer( SI.nPage ) + 1,
|
|
SI.nPage, SI.nPos );
|
|
end;
|
|
|
|
procedure CheckOverridenSBars( wnd: HWnd; msg, event, time: DWORD ); stdcall;
|
|
var i: Integer;
|
|
Control2Override: PControl;
|
|
begin
|
|
if ListOfOverridenSBars = nil then Exit;
|
|
for i := 0 to ListOfOverridenSBars.Count-1 do
|
|
begin
|
|
Control2Override := ListOfOverridenSBars.Items[ i ];
|
|
Control2Override.Perform( CM_AUTOSIZE, 0, 0 );
|
|
end;
|
|
end;
|
|
|
|
type TGetScrollbarInfo = function( Wnd: HWnd; Obj: Integer; var Info: TScrollBarInfo ): BOOL;
|
|
stdcall;
|
|
var GetScrollbarInfo: TGetScrollbarInfo;
|
|
|
|
function WndProcOverrideScrollbars( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
|
|
var O: POverrideScrollbars;
|
|
HasHBar, HasVBar: Boolean;
|
|
|
|
function CreateScrollbarReplacement( Ctl: PControl; Direction: TScrollerBar;
|
|
Flag: DWORD; var SBar: PControl ): Boolean;
|
|
var SBI: TScrollBarInfo;
|
|
R: TRect;
|
|
ParentWnd: Hwnd;
|
|
Wnd: HWnd;
|
|
//M: TMsg;
|
|
SBarCtl: PControl;
|
|
wasSBarVisible: Boolean;
|
|
E: Boolean;
|
|
M: THandle;
|
|
begin
|
|
Result := FALSE;
|
|
SBI.cbSize := Sizeof( SBI );
|
|
Wnd := Ctl.Handle;
|
|
if not Assigned( GetScrollbarInfo ) then
|
|
begin
|
|
M := GetModuleHandle( 'user32' );
|
|
GetScrollbarInfo := GetProcAddress( M, 'GetScrollBarInfo' );
|
|
end;
|
|
if GetScrollbarInfo( Wnd, Integer( Flag ), SBI ) and
|
|
(SBI.rcScrollBar.Bottom > 0) and
|
|
(SBI.rcScrollBar.Right > 0) then
|
|
begin
|
|
if not IsWindowVisible( Wnd ) or
|
|
(SBI.rgstate[0] and STATE_SYSTEM_INVISIBLE <> 0) then
|
|
begin
|
|
{if not PeekMessage( M, Ctl.Handle, CM_AUTOSIZE, CM_AUTOSIZE, pm_noremove )
|
|
and (SBar = nil) then
|
|
Ctl.Postmsg( WM_USER+1, 0, 0 );}
|
|
end
|
|
else
|
|
begin
|
|
E := not( (SBI.rgstate[1] and STATE_SYSTEM_UNAVAILABLE <> 0) and
|
|
(SBI.rgstate[5] and STATE_SYSTEM_UNAVAILABLE <> 0) );
|
|
|
|
if (SBI.rcScrollBar.Left < SBI.rcScrollBar.Right) and
|
|
(SBI.rcScrollBar.Top < SBI.rcScrollBar.Bottom) then
|
|
begin
|
|
Result := TRUE;
|
|
if Wnd = Ctl.Handle then ParentWnd := Ctl.Parent.Handle
|
|
else begin
|
|
ParentWnd := Wnd; //GetWindow( Wnd, GW_OWNER );
|
|
SetWindowLong( Wnd, GWL_STYLE,
|
|
GetWindowLong( Wnd, GWL_STYLE )
|
|
or WS_CLIPCHILDREN );
|
|
end;
|
|
|
|
if SBar = nil then
|
|
begin
|
|
SBar := NewScrollBar( Ctl.Parent, Direction );
|
|
if Wnd <> Ctl.Handle then
|
|
SetParent( SBar.Handle, ParentWnd );
|
|
SBar.Tag := DWORD( Ctl );
|
|
SBar.OnSBScroll := O.ReplacedScrollBar2Original;
|
|
end;
|
|
SBarCtl := SBar;
|
|
SBarCtl.RefInc;
|
|
TRY
|
|
R := SBI.rcScrollBar;
|
|
Windows.ScreenToClient( ParentWnd, R.TopLeft );
|
|
Windows.ScreenToClient( ParentWnd, R.BottomRight );
|
|
if not RectsEqual( SBarCtl.BoundsRect, R ) then
|
|
SBarCtl.BoundsRect := R;
|
|
if SBar <> nil then
|
|
begin
|
|
if Wnd = Ctl.Handle then SBarCtl.BringToFront
|
|
else begin
|
|
SBarCtl.Visible := TRUE;
|
|
SBarCtl.StayOnTop := TRUE;
|
|
SBarCtl.BringToFront;
|
|
end;
|
|
end;
|
|
if E <> SBarCtl.Enabled then
|
|
begin
|
|
SBarCtl.Enabled := E;
|
|
SBarCtl.EnableChildren( E, FALSE );
|
|
end;
|
|
FINALLY
|
|
SBarCtl.RefDec;
|
|
END;
|
|
end;
|
|
end;
|
|
end;
|
|
if not Result and (SBar <> nil) then
|
|
begin
|
|
wasSBarVisible := SBar.Visible;
|
|
SBar.Visible := FALSE;
|
|
if wasSBarVisible then
|
|
Ctl.Invalidate;
|
|
//Free_And_Nil( SBar );
|
|
end;
|
|
end;
|
|
|
|
var TimerHandle: DWORD;
|
|
R1, R2, RGrip: TRect;
|
|
begin
|
|
Result := FALSE;
|
|
CASE M.message OF
|
|
WM_NCPAINT: // ������ ������������ ���������������: �������� �������
|
|
// ����������� ��-���������� ����� (�� ����������� ��������, �
|
|
// ������ ������ ����)
|
|
Sender.Postmsg( CM_AUTOSIZE, 0, 0 );
|
|
WM_SIZE, WM_VSCROLL, WM_HSCROLL, WM_WINDOWPOSCHANGING, WM_WINDOWPOSCHANGED,
|
|
WM_PAINT, CM_AUTOSIZE
|
|
//, WM_MOUSEWHEEL, WM_LBUTTONUP, WM_KEYUP, WM_SYSKEYUP
|
|
:
|
|
if Sender.ToBeVisible then
|
|
begin
|
|
O := Pointer( Sender.CustomObj );
|
|
if not O.Handling then
|
|
begin
|
|
O.Handling := TRUE;
|
|
TRY
|
|
HasHBar := CreateScrollbarReplacement( Sender,
|
|
sbHorizontal, OBJID_HSCROLL, O.HBar );
|
|
HasVBar := CreateScrollbarReplacement( Sender,
|
|
sbVertical, OBJID_VSCROLL, O.VBar );
|
|
|
|
if HasHBar then
|
|
WindowScrollbar2GrushScrollbar( Sender,
|
|
O.HBar, SB_HORZ );
|
|
if HasVBar then
|
|
WindowScrollbar2GrushScrollbar( Sender,
|
|
O.VBar, SB_VERT );
|
|
|
|
if HasHBar or HasVBar then
|
|
begin
|
|
if not O.Added2List then
|
|
begin
|
|
if ListOfOverridenSBars = nil then
|
|
begin
|
|
ListOfOverridenSBars := NewList;
|
|
TimerHandle := SetTimer( 0, 0, 250, @CheckOverridenSBars );
|
|
ListOfOverridenSBars.Tag := DWORD( TimerHandle );
|
|
end;
|
|
ListOfOverridenSBars.Add( O.Control2Override );
|
|
O.Added2List := TRUE;
|
|
end;
|
|
end;
|
|
|
|
if HasHBar and HasVBar then
|
|
begin
|
|
R1 := O.HBar.BoundsRect;
|
|
R2 := O.VBar.BoundsRect;
|
|
RGrip := MakeRect( R2.Left, R1.Top, R2.Right, R1.Bottom );
|
|
end
|
|
else
|
|
RGrip := MakeRect( 0, 0, 0, 0 );
|
|
if (RGrip.Left < RGrip.Right) and
|
|
(RGrip.Top < RGrip.Bottom) then
|
|
begin
|
|
if O.Grip = nil then
|
|
O.Grip := NewPaintbox( Sender.Parent ).MouseTransparent;
|
|
O.Grip.Color := Sender.Parent.Color;
|
|
O.Grip.BoundsRect := RGrip;
|
|
O.Grip.OnPaint := O.PaintGrip;
|
|
O.Grip.BringToFront;
|
|
end
|
|
else
|
|
begin
|
|
if O.Grip <> nil then
|
|
O.Grip.Visible := FALSE;
|
|
end;
|
|
FINALLY
|
|
O.Handling := FALSE;
|
|
END;
|
|
end;
|
|
end;
|
|
END;
|
|
end;
|
|
|
|
procedure OverrideScrollbars( C: PControl );
|
|
var O: POverrideScrollbars;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if NoGrush then Exit;
|
|
{$ENDIF}
|
|
new( O, Create ); O.Control2Override := C;
|
|
C.CustomObj := O;
|
|
C.AttachProc( WndProcOverrideScrollbars );
|
|
end;
|
|
|
|
{$ENDIF TOGRUSH_NO_SCROLLBARS}
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// COMBO BOX
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
type
|
|
PFixComboButton = ^TFixComboButton;
|
|
TFixComboButton = object( TObj )
|
|
Fixed: Boolean;
|
|
Button: PControl;
|
|
Combo: PControl;
|
|
Form, LB: PControl;
|
|
SzIncrease, TargetSz: Integer;
|
|
TimerAnimation: PTimer;
|
|
ClosedTime: DWORD;
|
|
procedure DoDropDownList;
|
|
procedure LBData( Sender: PControl; Idx, SubItem: Integer;
|
|
var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD;
|
|
var Store: Boolean );
|
|
procedure SelectItemUnderCursor( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure KeyPressed( Sender: PControl; var Key: KOLChar; Shift: DWORD );
|
|
procedure CloseDropDown( SelectOK: Boolean );
|
|
procedure SelectItemByMouse( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure SelectItemByMouse2( Sender: PControl; var Mouse: TMouseEventData );
|
|
procedure AnimateDropDown( Sender: PObj );
|
|
function Deactivation( var M: TMsg; var Rslt: Integer ): Boolean;
|
|
end;
|
|
|
|
{ TFixComboButton }
|
|
|
|
procedure TFixComboButton.LBData(Sender: PControl; Idx, SubItem: Integer;
|
|
var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD;
|
|
var Store: Boolean);
|
|
begin
|
|
Txt := Combo.Items[ Idx ];
|
|
end;
|
|
|
|
procedure TFixComboButton.SelectItemUnderCursor(Sender: PControl;
|
|
var Mouse: TMouseEventData);
|
|
var i: Integer;
|
|
P: TPoint;
|
|
begin
|
|
if Form = nil then Exit;
|
|
P := MakePoint( Mouse.X, Mouse.Y );
|
|
P := Form.Client2Screen( P );
|
|
P := LB.Screen2Client( P );
|
|
i := LB.LVItemAtPos( Mouse.X, Mouse.Y );
|
|
if i >= 0 then
|
|
LB.LVCurItem := i;
|
|
end;
|
|
|
|
procedure TFixComboButton.KeyPressed(Sender: PControl; var Key: KOLChar;
|
|
Shift: DWORD);
|
|
begin
|
|
CASE Key OF
|
|
#13: if LB.LVCurItem >= 0 then CloseDropDown( TRUE );
|
|
#27: CloseDropDown( FALSE );
|
|
END;
|
|
end;
|
|
|
|
procedure TFixComboButton.SelectItemByMouse(Sender: PControl;
|
|
var Mouse: TMouseEventData);
|
|
var i: Integer;
|
|
P: TPoint;
|
|
begin
|
|
P := MakePoint( Mouse.X, Mouse.Y );
|
|
P := Form.Client2Screen( P );
|
|
P := LB.Screen2Client( P );
|
|
i := LB.LVItemAtPos( P.X, P.Y );
|
|
if i >= 0 then
|
|
LB.LVCurItem := i;
|
|
{if Mouse.Button = mbLeft then
|
|
SetCapture( Form.Handle );}
|
|
{if Mouse.Button = mbLeft then
|
|
if i >= 0 then CloseDropDown( TRUE );}
|
|
end;
|
|
|
|
procedure TFixComboButton.SelectItemByMouse2(Sender: PControl;
|
|
var Mouse: TMouseEventData);
|
|
var i: Integer;
|
|
P: TPoint;
|
|
begin
|
|
P := MakePoint( Mouse.X, Mouse.Y );
|
|
P := Form.Client2Screen( P );
|
|
P := LB.Screen2Client( P );
|
|
i := LB.LVItemAtPos( P.X, P.Y );
|
|
if i >= 0 then
|
|
LB.LVCurItem := i;
|
|
if Mouse.Button = mbLeft then
|
|
if i >= 0 then CloseDropDown( TRUE );
|
|
end;
|
|
|
|
procedure TFixComboButton.CloseDropDown(SelectOK: Boolean);
|
|
var i: Integer;
|
|
F: PControl;
|
|
begin
|
|
if TimerAnimation = nil then Exit;
|
|
TimerAnimation.Enabled := FALSE;
|
|
ClosedTime := GetTickCount;
|
|
i := LB.LVCurItem;
|
|
if SelectOK then Combo.CurIndex := i;
|
|
Free_And_Nil( TimerAnimation );
|
|
F := Form;
|
|
Form := nil;
|
|
LB := nil;
|
|
F.Close;
|
|
Combo.Focused := TRUE;
|
|
Applet.ActiveControl := Combo.ParentForm;
|
|
if SelectOK and Assigned( Combo.OnSelChange ) then
|
|
Combo.OnSelChange( Combo );
|
|
end;
|
|
|
|
function TFixComboButton.Deactivation(var M: TMsg; var Rslt: Integer): Boolean;
|
|
begin
|
|
Result := FALSE;
|
|
if M.message = WM_KILLFOCUS then
|
|
begin
|
|
CloseDropDown( FALSE );
|
|
end;
|
|
end;
|
|
|
|
procedure TFixComboButton.DoDropDownList;
|
|
var R: TRect;
|
|
n, h: Integer;
|
|
begin
|
|
if Assigned( Combo.OnDropDown ) then
|
|
Combo.OnDropDown( Combo );
|
|
R := Combo.BoundsRect;
|
|
if Combo.DroppedWidth > 0 then
|
|
R.Right := R.Left + Combo.DroppedWidth;
|
|
Windows.ClientToScreen( Combo.ParentWindow, R.TopLeft );
|
|
Windows.ClientToScreen( Combo.ParentWindow, R.BottomRight );
|
|
{$IFDEF USE_DROPDOWNCOUNT}
|
|
n := Combo.DropDownCount;
|
|
{$ELSE}
|
|
n := 8;
|
|
{$ENDIF}
|
|
if n > Combo.Count then n := Combo.Count;
|
|
if n < 1 then n := 1;
|
|
|
|
Form := NewForm( Applet, '' ).SetSize( R.Right - R.Left, 1 );
|
|
h := Combo.Font.FontHeight;
|
|
if h = 0 then h := 16;
|
|
TargetSz := n * (h+1);
|
|
SzIncrease := Max( 6, TargetSz div 5 );
|
|
if ScreenHeight - R.Bottom < n * (h + 1) then
|
|
begin
|
|
SzIncrease := -SzIncrease;
|
|
Form.SetPosition( R.Left, R.Top-1 );
|
|
end
|
|
else
|
|
Form.SetPosition( R.Left, R.Bottom );
|
|
Form.HasBorder := FALSE;
|
|
Form.Border := 0;
|
|
LB := NewListView( Form, lvsDetailNoHeader, [ lvoRowSelect, lvoInfoTip, lvoOwnerData ], nil, nil, nil )
|
|
.SetAlign( caClient );
|
|
LB.Ctl3D := False;
|
|
LB.Color := Combo.Color;
|
|
LB.Font.Assign( Combo.Font );
|
|
LB.LVColAdd( '', taLeft, R.Right - R.Left - 4 );
|
|
LB.OnLVData := LBData;
|
|
LB.MouseTransparent;
|
|
Form.OnMouseMove := SelectItemUnderCursor;
|
|
LB.OnKeyChar := KeyPressed;
|
|
Form.OnMouseDown := SelectItemByMouse;
|
|
Form.OnMouseUp := SelectItemByMouse2;
|
|
LB.LVCount := max( 1, Combo.Count );
|
|
LB.OnMessage := Deactivation;
|
|
OverrideScrollbars( LB );
|
|
TimerAnimation := NewTimer( 20 );
|
|
TimerAnimation.OnTimer := AnimateDropDown;
|
|
TimerAnimation.Enabled := TRUE;
|
|
Form.StayOnTop := TRUE;
|
|
Form.Show;
|
|
n := Combo.CurIndex;
|
|
if n >= 0 then
|
|
LB.LVMakeVisible( n, FALSE );
|
|
end;
|
|
|
|
procedure TFixComboButton.AnimateDropDown(Sender: PObj);
|
|
var BR: TRect;
|
|
begin
|
|
BR := Form.BoundsRect;
|
|
if SzIncrease < 0 then
|
|
inc( BR.Top, SzIncrease )
|
|
else
|
|
inc( BR.Bottom, SzIncrease );
|
|
if BR.Bottom - BR.Top > TargetSz+2 then
|
|
if SzIncrease < 0 then
|
|
BR.Top := Br.Bottom - TargetSz-2
|
|
else
|
|
BR.Bottom := Br.Top + TargetSz+2;
|
|
if not RectsEqual( Form.BoundsRect, BR ) then
|
|
Form.BoundsRect := BR
|
|
else
|
|
TimerAnimation.Enabled := FALSE;
|
|
end;
|
|
|
|
procedure ClickDropDownCombo( _Self, Sender: PControl );
|
|
{$IFNDEF TOGRUSH_NO_WINDOW_SCROLLBARS}
|
|
var F: PFixComboButton;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF TOGRUSH_NO_WINDOW_SCROLLBARS}
|
|
_Self.Perform( CB_SHOWDROPDOWN, 1 - _Self.Perform( CB_GETDROPPEDSTATE, 0, 0 ), 0 );
|
|
{$ELSE}
|
|
F := Pointer( _Self.CustomObj );
|
|
if GetTickCount - F.ClosedTime > 200 then
|
|
begin
|
|
F.Combo := _Self;
|
|
F.DoDropDownList;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function WndProcComboToGRush( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean;
|
|
var wnd: HWnd;
|
|
R: TRect;
|
|
C2: PControl;
|
|
Bdn: PBitmap;
|
|
F: PFixComboButton;
|
|
begin
|
|
Result := FALSE;
|
|
CASE M.message OF
|
|
WM_SIZE:
|
|
begin
|
|
F := Pointer( Sender.CustomObj );
|
|
if not F.Fixed then
|
|
begin
|
|
wnd := Sender.Handle;
|
|
if wnd <> 0 then
|
|
begin
|
|
wnd := GetWindow( wnd, GW_CHILD );
|
|
if wnd <> 0 then
|
|
SetWindowLong( wnd, GWL_EXSTYLE,
|
|
GetWindowLong( wnd, GWL_EXSTYLE ) and not WS_EX_CLIENTEDGE );
|
|
|
|
Sender.MarginTop := 1;
|
|
Sender.MarginLeft := 1;
|
|
Sender.MarginRight := 1;
|
|
Sender.MarginBottom := 1;
|
|
C2 := NewGRushButton( Sender, '' ).LikeSpeedButton //.SetAlign( caRight )
|
|
.SetSize( 18, 0 );
|
|
Bdn := TriangleDnBitmap( FALSE );
|
|
PGrushControl( C2 ).All_GlyphBitmap := Bdn;
|
|
PGrushControl( C2 ).All_GlyphHAlign := haCenter;
|
|
Bdn.Free;
|
|
C2.OnClick := TOnEvent( MakeMethod( Sender, @ClickDropDownCombo ) );
|
|
C2.BringToFront;
|
|
Sender.Invalidate;
|
|
F.Button := C2;
|
|
F.Fixed := TRUE;
|
|
end;
|
|
end;
|
|
if F.Fixed then
|
|
begin
|
|
C2 := F.Button;
|
|
C2.BringToFront;
|
|
R := Sender.ClientRect;
|
|
R.Left := R.Right - 18;
|
|
C2.BoundsRect := R;
|
|
end;
|
|
end;
|
|
END;
|
|
end;
|
|
|
|
{$IFNDEF TOGRUSH_NO_COMBO_EDIT}
|
|
function NewComboBox( AParent: PControl; Options: TComboOptions ): PControl;
|
|
var F: PFixComboButton;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
Result := Kol.NewComboBox( AParent, Options );
|
|
new( F, Create ); Result.CustomObj := F;
|
|
Result.AttachProc( WndProcComboToGRush );
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewComboBox( AParent, Options )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
// EDIT BOX
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
|
|
{$IFNDEF TOGRUSH_NO_COMBO_EDIT}
|
|
function NewEditBox( AParent: PControl; Options: TEditOptions ): PControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
Result := Kol.NewEditBox( AParent, Options );
|
|
Result.Ctl3D := FALSE;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewEditBox( AParent, Options )
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF TOGRUSH_NO_GRADIENTPANEL}
|
|
function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl;
|
|
var G: PGRushControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
G := NewGRushPanel( AParent );
|
|
Result := PControl( G );
|
|
G.Def_ColorFrom := Color1;
|
|
G.Def_ColorTo := Color2;
|
|
G.Def_BorderWidth := 0;
|
|
G.Def_BorderRoundWidth := 0;
|
|
G.Def_BorderRoundHeight := 0;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewGradientPanel( AParent, Color1, Color2 );
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
|
|
function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor;
|
|
Style: TGradientStyle; Layout: TGradientLayout ): PControl;
|
|
var G: PGRushControl;
|
|
begin
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
if not NoGrush then
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
begin
|
|
G := NewGRushPanel( AParent );
|
|
Result := PControl( G );
|
|
G.Def_ColorFrom := Color1;
|
|
G.Def_ColorTo := Color2;
|
|
G.Def_BorderWidth := 0;
|
|
G.Def_BorderRoundWidth := 0;
|
|
G.Def_BorderRoundHeight := 0;
|
|
CASE Layout OF
|
|
glTopLeft : G.Def_GradientStyle := gsFromTopLeft;
|
|
glTop : G.Def_GradientStyle := gsVertical;
|
|
glTopRight: G.Def_GradientStyle := gsFromTopRight;
|
|
glLeft : G.Def_GradientStyle := gsHorizontal;
|
|
glCenter : G.Def_GradientStyle := gsDoubleVert;
|
|
glRight : begin
|
|
G.Def_ColorFrom := Color2;
|
|
G.Def_ColorTo := Color1;
|
|
G.Def_GradientStyle := gsHorizontal;
|
|
end;
|
|
glBottomLeft: begin
|
|
G.Def_ColorFrom := Color2;
|
|
G.Def_ColorTo := Color1;
|
|
G.Def_GradientStyle := gsFromTopRight;
|
|
end;
|
|
glBottom : begin
|
|
G.Def_ColorFrom := Color2;
|
|
G.Def_ColorTo := Color1;
|
|
G.Def_GradientStyle := gsVertical;
|
|
end;
|
|
glBottomRight:
|
|
begin
|
|
G.Def_ColorFrom := Color2;
|
|
G.Def_ColorTo := Color1;
|
|
G.Def_GradientStyle := gsFromTopRight;
|
|
end;
|
|
END;
|
|
end
|
|
{$IFDEF TOGRUSH_OPTIONAL}
|
|
else Result := Kol.NewGradientPanelEx( AParent, Color1, Color2, Style,
|
|
Layout );
|
|
{$ENDIF TOGRUSH_OPTIONAL}
|
|
;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function FindMenuItemByID( Menu: PMenu; ID: DWORD; var MaxTabulation: Integer ): PMenu;
|
|
var i, j, t: Integer;
|
|
begin
|
|
Result := nil;
|
|
for j := 0 to Menu.Count-1 do
|
|
begin
|
|
if Menu.ItemHandle[ j ] = ID then
|
|
begin
|
|
Result := Menu.Items[ j ];
|
|
break;
|
|
end;
|
|
if Menu.Count > 0 then
|
|
begin
|
|
Result := FindMenuItemByID( Menu.Items[ j ], ID, MaxTabulation );
|
|
if Result <> nil then break;
|
|
end;
|
|
end;
|
|
if Result <> nil then
|
|
begin
|
|
MaxTabulation := 6;
|
|
Menu := Result.Parent;
|
|
for i := 0 to Menu.Count-1 do
|
|
begin
|
|
t := pos( #9, Menu.ItemText[ i ] );
|
|
if t > MaxTabulation then MaxTabulation := t;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var Menubmp: PBitmap;
|
|
function OwnerDrawMenuItem( var Msg: TMsg; const Menus: array of PMenu;
|
|
var Rslt: Integer): Boolean;
|
|
var Menu, Item: PMenu;
|
|
i, w1, y, m: Integer;
|
|
DC: HDC;
|
|
Sav: DWORD;
|
|
IsCheckItem: Boolean;
|
|
R: TRect;
|
|
MaxTabulation: Integer;
|
|
C: PCanvas;
|
|
s: KOLString;
|
|
Cside: Integer;
|
|
B_Color: TColor;
|
|
DI: PDrawItemStruct;
|
|
MI: PMeasureItemStruct;
|
|
ell: Integer;
|
|
|
|
procedure SetupCanvasFont;
|
|
begin
|
|
C := Menubmp.Canvas;
|
|
C.Font.FontName := 'Arial';
|
|
C.Font.FontHeight := Max( 6, GetSystemMetrics( SM_CYMENU ) - 4 );
|
|
C.Font.FontStyle := [ fsBold ];
|
|
C.Font.Color := MenuTextColor;
|
|
end;
|
|
begin
|
|
Result := FALSE;
|
|
if (Msg.message = WM_DRAWITEM) and (Msg.wParam = 0) then
|
|
begin
|
|
DI := Pointer( Msg.lParam );
|
|
Item := nil;
|
|
// ����� ����
|
|
for m := 0 to High( Menus ) do
|
|
begin
|
|
Menu := Menus[ m ];
|
|
Item := FindMenuItemByID( Menu, DI.itemID, MaxTabulation );
|
|
if Item <> nil then break;
|
|
end;
|
|
if Item = nil then Exit;
|
|
IsCheckItem := Item.IsCheckItem;
|
|
// ����� ������
|
|
R := DI.rcItem;
|
|
OffsetRect( R, -R.Left, -R.Top );
|
|
DC := DI.hDC;
|
|
Sav := SaveDC( DC );
|
|
// ���������� �����������
|
|
if (Menubmp <> nil) and (
|
|
(Menubmp.Width < R.Right) or
|
|
(Menubmp.Height < R.Bottom)
|
|
) then Free_And_Nil( Menubmp );
|
|
Menubmp := NewDibBitmap( R.Right, R.Bottom, pf32bit );
|
|
|
|
SetupCanvasFont;
|
|
C.Font.Color := MenuTextColor;
|
|
if not Item.Enabled then
|
|
C.Font.Color := MenuTextDisabled;
|
|
{if WinVer < wvXP then} C.Font.FontQuality := fqAntialiased
|
|
{else C.Font.FontQuality := fqClearType};
|
|
|
|
if DI.itemState and ODS_SELECTED <> 0 then
|
|
begin
|
|
C.Brush.Color := MenuHighlight;
|
|
C.Font.Color := MenuTextHighlight;
|
|
if not Item.Enabled then
|
|
begin
|
|
C.Font.Color := MenuTextDisabSel;
|
|
C.Brush.Color := ColorsMix( C.Brush.Color, clSilver );
|
|
end;
|
|
end
|
|
else
|
|
C.Brush.Color := MenuBackground;
|
|
B_Color := C.Brush.Color;
|
|
|
|
C.FillRect( R );
|
|
Cside := R.Bottom - 4;
|
|
if IsCheckItem then
|
|
begin // ���-����
|
|
C.Pen.Color := MenuCheckBoxBorder;
|
|
C.Pen.PenWidth := 1;
|
|
C.Brush.Color := MenuCheckBoxBkColor;
|
|
{$IFDEF ROUND_RADIOITEMS}
|
|
if Item.RadioGroup <> 0 then
|
|
C.Ellipse( 2, 2, Cside+2, Cside+2 )
|
|
else
|
|
{$ENDIF ROUND_RADIOITEMS}
|
|
begin
|
|
C.FillRect( MakeRect( 2, 2, Cside+2, Cside+2 ) );
|
|
C.Brush.Color := MenuCheckBoxBorder;
|
|
C.FrameRect( MakeRect( 2, 2, Cside+2, Cside+2 ) );
|
|
end;
|
|
if Item.Checked then
|
|
begin
|
|
{$IFDEF ROUND_RADIOITEMS}
|
|
if Item.RadioGroup <> 0 then
|
|
begin
|
|
C.Pen.Color := MenuCheckBoxCheck;
|
|
C.Brush.Color := MenucheckBoxCheck;
|
|
ell := Max( 2, Min( Cside div 4, Cside-4 ) );
|
|
C.Ellipse( 2+ell, 2+ell, Cside+2-ell, Cside+2-ell );
|
|
end
|
|
else
|
|
{$ENDIF ROUND_RADIOITEMS}
|
|
begin
|
|
C.Pen.Color := MenuCheckBoxCheck;
|
|
C.Pen.PenWidth := 2;
|
|
C.MoveTo( 2 + 1, 2 + Cside div 2 );
|
|
C.LineTo( 2 + Cside div 2, 2 + Cside - 2 );
|
|
C.LineTo( 2 + Cside - 1, 3 );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
C.Brush.Color := B_Color;
|
|
|
|
s := Item.Caption;
|
|
if s = '' then
|
|
begin
|
|
C.Brush.Color := MenuLine1Color;
|
|
y := R.Bottom div 2;
|
|
C.FillRect( MakeRect( 2, y, R.Right-2, y + 1 ) );
|
|
C.Brush.Color := MenuLine2Color;
|
|
C.FillRect( MakeRect( 2, y+1, R.Right-2, y+2 ) );
|
|
end
|
|
else
|
|
begin
|
|
s := Parse( s, #9 );
|
|
C.RequiredState( HandleValid or FONTVALID or BrushValid or ChangingCanvas );
|
|
R.Left := Cside + 4;
|
|
R.Top := 1;
|
|
DrawTextEx( C.Handle, PKOLChar( s ), Length( s ),
|
|
R, DT_LEFT or DT_SINGLELINE {$IFDEF RED_ACCELERATORS} or DT_HIDEPREFIX {$ENDIF}, nil );
|
|
{$IFDEF RED_ACCELERATORS}
|
|
i := pos( '&', s );
|
|
if i > 0 then
|
|
begin
|
|
w1 := C.TextWidth( Copy( s, 1, i-1 ) );
|
|
C.DeselectHandles;
|
|
C.Font.Color := MenuAccelColor;
|
|
if not Item.Enabled then
|
|
C.Font.Color := //ColorsMix( C.Font.Color, clSilver );
|
|
MenuAccelDisabled;
|
|
if DI.itemState and ODS_SELECTED <> 0 then
|
|
begin
|
|
C.Font.Color := MenuAccelSelColor;
|
|
if not Item.Enabled then
|
|
C.Font.Color := //ColorsMix( C.Font.Color, clSilver );
|
|
MenuAccelSelDisabled;
|
|
end;
|
|
C.TextOut( R.Left + w1, R.Top, Copy( s, i+1, 1 ) );
|
|
end;
|
|
{$ENDIF RED_ACCELERATORS}
|
|
{if s <> '' then w1 := C.TextWidth( 'Abcw' ) div 4
|
|
else} w1 := 10;
|
|
s := Item.Caption;
|
|
Parse( s, #9 );
|
|
if s <> '' then
|
|
begin
|
|
C.Font.Color := MenuHotKeyTextColor;
|
|
if not Item.Enabled then
|
|
C.Font.Color := //ColorsMix( C.Font.Color, clSilver );
|
|
MenuHotKeyTxDisabled;
|
|
if DI.itemState and ODS_SELECTED <> 0 then
|
|
begin
|
|
C.Font.Color := MenuHotKeySelTxColor;
|
|
if not Item.Enabled then
|
|
C.Font.Color := //ColorsMix( C.Font.Color, clSilver );
|
|
MenuHotKeySelTxDisabled;
|
|
end;
|
|
C.Brush.BrushStyle := bsClear;
|
|
C.TextOut( (Cside + 4) + w1 * MaxTabulation, 1, s );
|
|
C.Brush.BrushStyle := bsSolid;
|
|
end;
|
|
end;
|
|
//Menubmp.SaveToFile( GetStartDir + 'test_custom_menu.bmp' );
|
|
R := DI.rcItem;
|
|
//C.DeselectHandles;
|
|
RestoreDC( DC, Sav );
|
|
BitBlt( DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
|
Menubmp.Canvas.Handle, 0, 0, SRCCOPY );
|
|
//SetBkColor( DC, clGRushNormal );
|
|
|
|
//Result := TRUE;
|
|
Rslt := 1;
|
|
end
|
|
else
|
|
if Msg.message = WM_MEASUREITEM then
|
|
begin
|
|
MI := Pointer( Msg.lParam );
|
|
if MI.CtlType <> ODT_MENU then Exit;
|
|
//Result := FALSE;
|
|
Item := nil;
|
|
// ����� ����
|
|
for i := 0 to High( Menus ) do
|
|
begin
|
|
Menu := Menus[ i ];
|
|
// ����� ��������
|
|
Item := FindMenuItemByID( Menu, MI.itemID, MaxTabulation );
|
|
if Item <> nil then break;
|
|
end;
|
|
if Item = nil then Exit;
|
|
// ���������� ������� ��������
|
|
if Menubmp = nil then
|
|
Menubmp := NewDibBitmap( 1, 1, pf32bit );
|
|
SetupCanvasFont;
|
|
s := Item.Caption;
|
|
s := Parse( s, #9 );
|
|
w1 := 10;
|
|
if s <> '' then
|
|
w1 := max( C.TextWidth(s), MaxTabulation * w1 )
|
|
else
|
|
w1 := max( MaxTabulation, 8 ) * w1;
|
|
s := Item.Caption;
|
|
Parse( s, #9 );
|
|
if Item.Caption <> '' then
|
|
MI.itemWidth := 20 + w1 + C.TextWidth(s)
|
|
else
|
|
MI.itemWidth := 20 + w1;
|
|
|
|
if Item.Caption <> '' then
|
|
MI.ItemHeight := Menubmp.Canvas.TextHeight( Item.Caption )+2
|
|
else
|
|
MI.itemHeight := 6;
|
|
|
|
Result := TRUE;
|
|
Rslt := 1;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
KOL.OverrideScrollbars := OverrideScrollbars;
|
|
|
|
finalization
|
|
|
|
Free_And_Nil( DrDownBmp );
|
|
{$IFNDEF TOGRUSH_NO_SCROLLBARS}
|
|
if SBBrush <> 0 then
|
|
DeleteObject( SBBrush );
|
|
{$ENDIF}
|
|
Free_And_Nil( Menubmp );
|
|
|
|
end.
|