pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

* some fixes

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@140 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2014-12-03 10:56:45 +00:00
parent a94d2b45c7
commit 70dda1a9a1
1 changed files with 74 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

126
Addons/KOLCCtrls.pas
View File

@ -1,8 +1,9 @@
unit KOLCCtrls; unit KOLCCtrls;
{$UNDEF UNICODE}
interface interface
{$I KOLDEF.INC}
uses uses
Windows, Messages, ShellAPI, KOL; Windows, Messages, ShellAPI, KOL;
@ -87,12 +88,12 @@ const
type type
PTrackbar = ^TTrackbar; PTrackbar = ^TTrackbar;
TTrackbarOption = (trbAutoTicks, trbEnableSelRange, trbFixedLength, TTrackbarOption = ( trbAutoTicks, trbEnableSelRange, trbFixedLength,
trbNoThumb, trbNoTicks, trbTooltips, trbTopLeftMarks, trbNoThumb, trbNoTicks, trbTooltips, trbTopLeftMarks,
trbVertical, trbNoBorder); trbVertical, trbNoBorder );
TTrackbarOptions = set of TTrackbarOption; TTrackbarOptions = Set Of TTrackbarOption;
TOnScroll = procedure(Sender: PTrackbar; Code: Integer) of object; TOnScroll = procedure( Sender: PTrackbar; Code: Integer ) of object;
{* Code: {* Code:
|<pre> |<pre>
TB_THUMBTRACK Slider movement (the user dragged the slider) TB_THUMBTRACK Slider movement (the user dragged the slider)
@ -107,25 +108,34 @@ type
|</pre> |</pre>
} }
TTrackbar = object(TControl) TTrackbar = object( TControl )
private private
function GetOnScroll: TOnScroll; function GetOnScroll: TOnScroll;
procedure SetOnScroll(const Value: TOnScroll); procedure SetOnScroll(const Value: TOnScroll);
function GetVal(const Index: Integer): Integer; function GetVal( const Index: Integer ): Integer;
procedure SetVal(const Index, Value: Integer); procedure SetVal(const Index, Value: Integer);
procedure SetThumbLen(const Index, Value: Integer); procedure SetThumbLen(const Index, Value: Integer);
procedure SetTickFreq(const Value: Integer);
procedure SetNumTicks(const Index, Value: Integer);
protected protected
public public
property OnScroll: TOnScroll read GetOnScroll write SetOnScroll; property OnScroll: TOnScroll read GetOnScroll write SetOnScroll;
property RangeMin: Integer index $80010007 read GetVal write SetVal; property RangeMin: Integer index $80010007 read GetVal write SetVal;
property RangeMax: Integer index $80020008 read GetVal write SetVal; property RangeMax: Integer index $80020008 read GetVal write SetVal;
property PageSize: Integer index $00160015 read GetVal write SetVal; property PageSize: Integer index $00160015 read GetVal write SetVal;
{* to scroll with PgUp/PgDn }
property LineSize: Integer index $00180017 read GetVal write SetVal; property LineSize: Integer index $00180017 read GetVal write SetVal;
{* to scroll with arrow keys }
property Position: Integer index $80000005 read GetVal write SetVal; property Position: Integer index $80000005 read GetVal write SetVal;
property NumTicks: Integer index $00100000 read GetVal; property NumTicks: Integer index $00100000 read GetVal write SetNumTicks;
{* set approximately via TickFreq, returns actual tick mark count }
property TickFreq: Integer write SetTickFreq;
{* 2 means that one tick will be drawn for 2 tick marks }
property SelStart: Integer index $0011000B read GetVal write SetVal; property SelStart: Integer index $0011000B read GetVal write SetVal;
property SelEnd: Integer index $0012000C read GetVal write SetVal; property SelEnd : Integer index $0012000C read GetVal write SetVal;
property ThumbLen: Integer index $001B0000 read GetVal write SetThumbLen; property ThumbLen: Integer index $001B0000 read GetVal write SetThumbLen;
{* trbFixedLength should be on to have effect }
function ChannelRect: TRect;
end; end;
PTrackbarData = ^TTrackbarData; PTrackbarData = ^TTrackbarData;
@ -469,7 +479,6 @@ type
TSPCStatus = object(TControl) TSPCStatus = object(TControl)
private private
{ Private declarations } { Private declarations }
fControl: PControl;
function GetTop: Integer; function GetTop: Integer;
procedure SetTop(Value: Integer); procedure SetTop(Value: Integer);
function GetLeft: Integer; function GetLeft: Integer;
@ -483,6 +492,7 @@ type
protected protected
{ Protected declarations } { Protected declarations }
public public
fControl: PControl;
destructor Destroy; virtual; destructor Destroy; virtual;
function SetAlign(Value: TControlAlign): PSPCStatus; overload; function SetAlign(Value: TControlAlign): PSPCStatus; overload;
function SetPosition(X, Y: integer): PSPCStatus; overload; function SetPosition(X, Y: integer): PSPCStatus; overload;
@ -512,73 +522,81 @@ function NewTSPCStatusBar(AOwner: PControl): PSPCStatus;
implementation implementation
function WndProcTrackbarParent(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; function WndProcTrackbarParent( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT ): Boolean;
var var D: PTrackbarData;
D : PTrackbarData; Trackbar: PTrackbar;
Trackbar : PTrackbar;
begin begin
Result := False; Result := FALSE;
if (Msg.message = WM_HSCROLL) or (Msg.message = WM_VSCROLL) then if (Msg.message = WM_HSCROLL) or (Msg.message = WM_VSCROLL) then
if (Msg.lParam <> 0) then begin if (Msg.lParam <> 0) then
Trackbar := Pointer({$IFDEF USE_PROP} begin
GetProp(Msg.lParam, ID_SELF) {$IFDEF USE_PROP}
{$ELSE} Trackbar := Pointer( GetProp( Msg.lParam, ID_SELF ) );
GetWindowLong(Msg.lParam, GWL_USERDATA) {$ELSE}
{$ENDIF}); Trackbar := Pointer( GetWindowLongPtr( Msg.lParam, GWLP_USERDATA ) );
if Assigned(Trackbar) then begin {$ENDIF}
D := Trackbar.CustomData; if Trackbar <> nil then
if Assigned(D.FOnScroll) then begin
D.FOnScroll(Trackbar, Msg.wParam); D := Trackbar.CustomData;
end; if Assigned( D.FOnScroll ) then
D.FOnScroll( Trackbar, Msg.wParam );
end; end;
end;
end; end;
function NewTrackbar(AParent: PControl; Options: TTrackbarOptions; OnScroll: TOnScroll): PTrackbar; function NewTrackbar( AParent: PControl; Options: TTrackbarOptions; OnScroll: TOnScroll ): PTrackbar;
const const TrackbarOptions: array[ TTrackbarOption ] of Integer = ( TBS_AUTOTICKS,
TrackbarOptions : array[TTrackbarOption] of Integer = (TBS_AUTOTICKS, TBS_ENABLESELRANGE, TBS_FIXEDLENGTH, TBS_NOTHUMB, TBS_NOTICKS, TBS_TOOLTIPS,
TBS_ENABLESELRANGE, TBS_FIXEDLENGTH, TBS_NOTHUMB, TBS_NOTICKS, TBS_TOOLTIPS, TBS_TOP, TBS_VERT, 0 );
TBS_TOP, TBS_VERT, 0); var aStyle: DWORD;
var D: PTrackbarData;
aStyle : DWORD; W, H: Integer;
D : PTrackbarData;
W, H : Integer;
begin begin
DoInitCommonControls(ICC_BAR_CLASSES); DoInitCommonControls( ICC_BAR_CLASSES );
aStyle := MakeFlags(@Options, TrackbarOptions) or WS_CHILD or WS_VISIBLE; aStyle := MakeFlags( @Options, TrackbarOptions ) or WS_CHILD or WS_VISIBLE;
Result := PTrackbar(_NewCommonControl(AParent, TRACKBAR_CLASS, aStyle, Result := PTrackbar( _NewCommonControl( AParent, TRACKBAR_CLASS, aStyle,
not (trbNoBorder in Options), nil)); not (trbNoBorder in Options), nil ) );
W := 200; W := 200;
H := 40; H := 40;
if (trbVertical in Options) then begin if trbVertical in Options then
begin
H := W; H := W;
W := 40; W := 40;
end; end;
Result.Width := W; Result.Width := W;
Result.Height := H; Result.Height := H;
GetMem(D, Sizeof(D^)); GetMem( D, Sizeof( D^ ) );
Result.CustomData := D; Result.CustomData := D;
D.FOnScroll := OnScroll; D.FOnScroll := OnScroll;
AParent.AttachProc(WndProcTrackbarParent); AParent.AttachProc( WndProcTrackbarParent );
end; end;
{ TTrackbar } { TTrackbar }
function TTrackbar.ChannelRect: TRect;
begin
Perform( TBM_GETCHANNELRECT, 0, LPARAM( @ Result ) );
end;
function TTrackbar.GetOnScroll: TOnScroll; function TTrackbar.GetOnScroll: TOnScroll;
var var D: PTrackbarData;
D : PTrackbarData;
begin begin
D := CustomData; D := CustomData;
Result := D.FOnScroll; Result := D.FOnScroll;
end; end;
function TTrackbar.GetVal(const Index: Integer): Integer; function TTrackbar.GetVal( const Index: Integer ): Integer;
begin begin
Result := Perform(WM_USER + (HiWord(Index) and $7FFF), 0, 0); Result := Perform( WM_USER + ( HiWord( Index ) and $7FFF ), 0, 0 );
end;
procedure TTrackbar.SetNumTicks(const Index, Value: Integer);
begin
TickFreq := (RangeMax - RangeMin) div Value;
end; end;
procedure TTrackbar.SetOnScroll(const Value: TOnScroll); procedure TTrackbar.SetOnScroll(const Value: TOnScroll);
var var D: PTrackbarData;
D : PTrackbarData;
begin begin
D := CustomData; D := CustomData;
D.FOnScroll := Value; D.FOnScroll := Value;
@ -586,12 +604,17 @@ end;
procedure TTrackbar.SetThumbLen(const Index, Value: Integer); procedure TTrackbar.SetThumbLen(const Index, Value: Integer);
begin begin
Perform(TBM_SETTHUMBLENGTH, Value, 0); Perform( TBM_SETTHUMBLENGTH, Value, 0 );
end;
procedure TTrackbar.SetTickFreq(const Value: Integer);
begin
Perform( TBM_SETTICFREQ, Value, 0 );
end; end;
procedure TTrackbar.SetVal(const Index, Value: Integer); procedure TTrackbar.SetVal(const Index, Value: Integer);
begin begin
Perform(WM_USER + LoWord(Index), Index shr 31, Value); Perform( WM_USER + LoWord( Index ), Index shr 31, Value );
end; end;
{ TSPCDirectoryEdit } { TSPCDirectoryEdit }
@ -1770,4 +1793,3 @@ begin
end; end;
end. end.