mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-10 04:48:36 +02:00
added TMemoScrollBar
git-svn-id: trunk@3981 -
This commit is contained in:
mattias
parent
3c1c4757ca
commit
a66925277d
@ -243,9 +243,13 @@ begin
|
||||
if Result=nil then begin
|
||||
// load new buffer
|
||||
Result:=TCodeBuffer.Create;
|
||||
Result.Filename:=AFilename;
|
||||
if (not FileExists(Result.Filename))
|
||||
or (not Result.LoadFromFile(Result.Filename)) then
|
||||
if (not FileExists(AFilename)) then begin
|
||||
Result.Free;
|
||||
Result:=nil;
|
||||
exit;
|
||||
end;
|
||||
Result.Filename:=GetFilenameOnDisk(AFilename);
|
||||
if (not Result.LoadFromFile(Result.Filename)) then
|
||||
begin
|
||||
Result.Free;
|
||||
Result:=nil;
|
||||
@ -659,15 +663,15 @@ end;
|
||||
|
||||
function TCodeBuffer.LoadFromFile(const AFilename: string): boolean;
|
||||
begin
|
||||
//writeln('[TCodeBuffer.LoadFromFile] WriteLock=',WriteLock,' ReadOnly=',ReadOnly,
|
||||
//' IsVirtual=',IsVirtual,' Old="',Filename,'" ',CompareFilenames(AFilename,Filename));
|
||||
//writeln('[TCodeBuffer.LoadFromFile] WriteLock=',WriteLock,' ReadOnly=',ReadOnly,
|
||||
//' IsVirtual=',IsVirtual,' Old="',Filename,'" ',CompareFilenames(AFilename,Filename));
|
||||
if (WriteLock>0) or (ReadOnly) then begin
|
||||
Result:=false;
|
||||
exit;
|
||||
end;
|
||||
if not IsVirtual then begin
|
||||
if CompareFilenames(AFilename,Filename)=0 then begin
|
||||
//writeln('****** [TCodeBuffer.LoadFromFile] ',Filename,' FileDateValid=',FileDateValid,' ',FFileDate,',',FileAge(Filename),',',FFileChangeStep,',',ChangeStep,', NeedsUpdate=',FileNeedsUpdate);
|
||||
//writeln('****** [TCodeBuffer.LoadFromFile] ',Filename,' FileDateValid=',FileDateValid,' ',FFileDate,',',FileAge(Filename),',',FFileChangeStep,',',ChangeStep,', NeedsUpdate=',FileNeedsUpdate);
|
||||
if FileNeedsUpdate then begin
|
||||
Result:=inherited LoadFromFile(AFilename);
|
||||
if Result then MakeFileDateValid;
|
||||
@ -685,7 +689,7 @@ end;
|
||||
function TCodeBuffer.SaveToFile(const AFilename: string): boolean;
|
||||
begin
|
||||
Result:=inherited SaveToFile(AFilename);
|
||||
//writeln('TCodeBuffer.SaveToFile ',Filename,' -> ',AFilename,' ',Result);
|
||||
//writeln('TCodeBuffer.SaveToFile ',Filename,' -> ',AFilename,' ',Result);
|
||||
if CompareFilenames(AFilename,Filename)=0 then begin
|
||||
if FIsDeleted then FIsDeleted:=not Result;
|
||||
if Result then MakeFileDateValid;
|
||||
|
||||
@ -495,9 +495,9 @@ end;
|
||||
function TCodeToolManager.LoadFile(const ExpandedFilename: string;
|
||||
UpdateFromDisk, Revert: boolean): TCodeBuffer;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('>>>>>> [TCodeToolManager.LoadFile] ',ExpandedFilename,' Update=',UpdateFromDisk,' Revert=',Revert);
|
||||
{$ENDIF}
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('>>>>>> [TCodeToolManager.LoadFile] ',ExpandedFilename,' Update=',UpdateFromDisk,' Revert=',Revert);
|
||||
{$ENDIF}
|
||||
Result:=SourceCache.LoadFile(ExpandedFilename);
|
||||
if Result<>nil then begin
|
||||
if Revert then
|
||||
@ -510,9 +510,9 @@ end;
|
||||
function TCodeToolManager.CreateFile(const AFilename: string): TCodeBuffer;
|
||||
begin
|
||||
Result:=SourceCache.CreateFile(AFilename);
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('****** TCodeToolManager.CreateFile "',AFilename,'" ',Result<>nil);
|
||||
{$ENDIF}
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('****** TCodeToolManager.CreateFile "',AFilename,'" ',Result<>nil);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TCodeToolManager.SaveBufferAs(OldBuffer: TCodeBuffer;
|
||||
|
||||
@ -55,6 +55,7 @@ const
|
||||
function CompareFilenames(const Filename1, Filename2: string): integer;
|
||||
function CompareFileExt(const Filename, Ext: string;
|
||||
CaseSensitive: boolean): integer;
|
||||
function GetFilenameOnDisk(const AFilename: string): string;
|
||||
function DirectoryExists(DirectoryName: string): boolean;
|
||||
function ExtractFileNameOnly(const AFilename: string): string;
|
||||
function FilenameIsAbsolute(TheFilename: string):boolean;
|
||||
@ -157,6 +158,11 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function GetFilenameOnDisk(const AFilename: string): string;
|
||||
begin
|
||||
Result:=AFilename;
|
||||
end;
|
||||
|
||||
function DirectoryExists(DirectoryName: string): boolean;
|
||||
var sr: TSearchRec;
|
||||
begin
|
||||
|
||||
@ -215,6 +215,12 @@ type
|
||||
(ptApplication, ptProgram, ptCustomProgram);
|
||||
TProjectFlag = (pfSaveClosedUnits, pfSaveOnlyProjectUnits);
|
||||
TProjectFlags = set of TProjectFlag;
|
||||
|
||||
TProjectFileSearchFlag = (
|
||||
pfsfResolveFileLinks,
|
||||
pfsfOnlyEditorFiles
|
||||
);
|
||||
TProjectFileSearchFlags = set of TProjectFileSearchFlag;
|
||||
|
||||
TProject = class(TObject)
|
||||
private
|
||||
@ -302,6 +308,8 @@ type
|
||||
function IndexOfUnitWithFormName(const AFormName: string;
|
||||
OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer;
|
||||
function IndexOfFilename(const AFilename: string): integer;
|
||||
function IndexOfFilename(const AFilename: string;
|
||||
SearchFlags: TProjectFileSearchFlags): integer;
|
||||
function ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
|
||||
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
|
||||
function UnitWithEditorIndex(Index:integer): TUnitInfo;
|
||||
@ -2077,6 +2085,30 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TProject.IndexOfFilename(const AFilename: string;
|
||||
SearchFlags: TProjectFileSearchFlags): integer;
|
||||
var
|
||||
BaseFilename: String;
|
||||
CurBaseFilename: String;
|
||||
begin
|
||||
BaseFilename:=AFilename;
|
||||
if pfsfResolveFileLinks in SearchFlags then
|
||||
BaseFilename:=ReadAllLinks(AFilename,false);
|
||||
Result:=UnitCount-1;
|
||||
while (Result>=0) do begin
|
||||
if (pfsfOnlyEditorFiles in SearchFlags)
|
||||
and (Units[Result].EditorIndex>=0) then begin
|
||||
dec(Result);
|
||||
continue;
|
||||
end;
|
||||
CurBaseFilename:=Units[Result].Filename;
|
||||
if pfsfResolveFileLinks in SearchFlags then
|
||||
CurBaseFilename:=ReadAllLinks(CurBaseFilename,false);
|
||||
if CompareFilenames(BaseFilename,CurBaseFilename)=0 then exit;
|
||||
dec(Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TProject.ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
|
||||
begin
|
||||
Result:=fFirstPartOfProject;
|
||||
@ -2253,6 +2285,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.100 2003/03/29 17:20:04 mattias
|
||||
added TMemoScrollBar
|
||||
|
||||
Revision 1.99 2003/03/25 17:11:16 mattias
|
||||
set Project.AutoCreateForms default to true
|
||||
|
||||
|
||||
@ -466,6 +466,7 @@ begin
|
||||
Add('Ascending');
|
||||
Add('Descending');
|
||||
Columns:=2;
|
||||
ItemIndex:=0;
|
||||
EndUpdate;
|
||||
end;
|
||||
OnClick:=@DirectionRadioGroupClick;
|
||||
@ -485,6 +486,7 @@ begin
|
||||
Add('Lines');
|
||||
Add('Words');
|
||||
Add('Paragraphs');
|
||||
ItemIndex:=0;
|
||||
Columns:=3;
|
||||
EndUpdate;
|
||||
end;
|
||||
|
||||
@ -45,6 +45,8 @@ uses
|
||||
|
||||
// file attributes and states
|
||||
function CompareFilenames(const Filename1, Filename2: string): integer;
|
||||
function CompareFilenames(const Filename1, Filename2: string;
|
||||
ResolveLinks: boolean): integer;
|
||||
function FilenameIsAbsolute(TheFilename: string):boolean;
|
||||
procedure CheckIfFileIsExecutable(const AFilename: string);
|
||||
procedure CheckIfFileIsSymlink(const AFilename: string);
|
||||
@ -124,6 +126,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 2003/03/29 17:20:05 mattias
|
||||
added TMemoScrollBar
|
||||
|
||||
Revision 1.15 2003/03/28 23:03:38 mattias
|
||||
started TMemoScrollbar
|
||||
|
||||
|
||||
61
lcl/forms.pp
61
lcl/forms.pp
@ -68,50 +68,61 @@ type
|
||||
TScrollBarKind = (sbHorizontal, sbVertical);
|
||||
TScrollBarInc = 1..32768;
|
||||
TScrollBarStyle = (ssRegular, ssFlat, ssHotTrack);
|
||||
EScrollBar = class(Exception) end;
|
||||
|
||||
TControlScrollBar = class(TPersistent)
|
||||
private
|
||||
FControl: TWinControl;
|
||||
|
||||
FAutoRange : Longint;
|
||||
|
||||
FKind: TScrollBarKind;
|
||||
|
||||
FIncrement: TScrollBarInc;
|
||||
FKind: TScrollBarKind;
|
||||
FPage: TScrollBarInc;
|
||||
FPosition: Integer;
|
||||
FRange: Integer;
|
||||
FSmooth : Boolean;
|
||||
FVisible: Boolean;
|
||||
function SmoothIsStored: boolean;
|
||||
function VisibleIsStored: boolean;
|
||||
protected
|
||||
function GetSize: integer; virtual;
|
||||
procedure SetPosition(Value: Integer); virtual;
|
||||
procedure SetRange(Value: Integer); virtual;
|
||||
procedure SetSize(const AValue: integer); virtual;
|
||||
procedure SetSmooth(Value: Boolean); virtual;
|
||||
procedure SetVisible(Value: Boolean); virtual;
|
||||
procedure ScrollControlBy(DeltaX, DeltaY: integer); virtual;
|
||||
procedure AutoCalcRange; virtual;
|
||||
Procedure UpdateScrollBar; virtual;
|
||||
FControl: TWinControl;
|
||||
function ControlAutoScroll: boolean; virtual;
|
||||
procedure ScrollHandler(var Message: TLMScroll);
|
||||
function ControlHandle: HWnd; virtual;
|
||||
function GetIncrement: TScrollBarInc; virtual;
|
||||
function GetPage: TScrollBarInc; virtual;
|
||||
function GetPosition: Integer; virtual;
|
||||
function GetRange: Integer; virtual;
|
||||
function GetSize: integer; virtual;
|
||||
function GetSmooth: Boolean; virtual;
|
||||
function GetVisible: Boolean; virtual;
|
||||
function HandleAllocated: boolean; virtual;
|
||||
function SmoothIsStored: boolean; virtual;
|
||||
function VisibleIsStored: boolean; virtual;
|
||||
procedure AutoCalcRange; virtual;
|
||||
procedure ControlUpdateScrollBars; virtual;
|
||||
procedure ScrollControlBy(DeltaX, DeltaY: integer); virtual;
|
||||
procedure ScrollHandler(var Message: TLMScroll);
|
||||
procedure SetIncrement(const AValue: TScrollBarInc); virtual;
|
||||
procedure SetPage(const AValue: TScrollBarInc); virtual;
|
||||
procedure SetPosition(const Value: Integer); virtual;
|
||||
procedure SetRange(const Value: Integer); virtual;
|
||||
procedure SetSize(const AValue: integer); virtual;
|
||||
procedure SetSmooth(const Value: Boolean); virtual;
|
||||
procedure SetVisible(const Value: Boolean); virtual;
|
||||
Procedure UpdateScrollBar; virtual;
|
||||
public
|
||||
constructor Create(AControl: TWinControl; AKind: TScrollBarKind);
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
function IsScrollBarVisible: Boolean; virtual;
|
||||
function ScrollPos: Integer; virtual;
|
||||
property Kind: TScrollBarKind read FKind;
|
||||
published
|
||||
property Increment: TScrollBarInc read FIncrement write FIncrement default 8;
|
||||
property Page: TScrollBarInc read FPage write FPage default 80;
|
||||
property Smooth : Boolean read FSmooth write SetSmooth stored SmoothIsStored;
|
||||
property Position: Integer read FPosition write SetPosition default 0;
|
||||
property Range: Integer read FRange write SetRange default 0;
|
||||
function GetOtherScrollBar: TControlScrollBar;
|
||||
function GetHorzScrollBar: TControlScrollBar; virtual;
|
||||
function GetVertScrollBar: TControlScrollBar; virtual;
|
||||
property Size: integer read GetSize write SetSize stored false;
|
||||
property Visible: Boolean read FVisible write SetVisible stored VisibleIsStored;
|
||||
published
|
||||
property Increment: TScrollBarInc read GetIncrement write SetIncrement default 8;
|
||||
property Page: TScrollBarInc read GetPage write SetPage default 80;
|
||||
property Smooth : Boolean read GetSmooth write SetSmooth stored SmoothIsStored;
|
||||
property Position: Integer read GetPosition write SetPosition default 0;
|
||||
property Range: Integer read GetRange write SetRange default 0;
|
||||
property Visible: Boolean read GetVisible write SetVisible stored VisibleIsStored;
|
||||
end;
|
||||
|
||||
|
||||
@ -983,7 +994,7 @@ end;
|
||||
|
||||
//==============================================================================
|
||||
|
||||
|
||||
{$I controlscrollbar.inc}
|
||||
{$I scrollingwincontrol.inc}
|
||||
{$I scrollbox.inc}
|
||||
{$I customform.inc}
|
||||
|
||||
@ -29,11 +29,13 @@ constructor TCustomMemo.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
fCompStyle := csMemo;
|
||||
Width:= 185;
|
||||
Height:= 89;
|
||||
FWordWrap := True;
|
||||
FFont := TFont.Create;
|
||||
FLines := TMemoStrings.Create(Self);
|
||||
FVertScrollbar := TMemoScrollBar.Create(Self, sbVertical);
|
||||
FHorzScrollbar := TMemoScrollBar.Create(Self, sbHorizontal);
|
||||
|
||||
SetBounds(0,0,185,90);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -47,6 +49,8 @@ destructor TCustomMemo.Destroy;
|
||||
begin
|
||||
FreeThenNil(FLines);
|
||||
FreeThenNil(FFont);
|
||||
FreeThenNil(FVertScrollbar);
|
||||
FreeThenNil(FHorzScrollbar);
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
@ -92,12 +96,10 @@ end;
|
||||
Returns:
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomMemo.SetLines(Value : TStrings);
|
||||
procedure TCustomMemo.SetLines(const Value : TStrings);
|
||||
begin
|
||||
if Value <> nil then
|
||||
begin
|
||||
if (Value <> nil) then
|
||||
FLines.Assign(Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -135,6 +137,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.12 2003/03/29 17:20:05 mattias
|
||||
added TMemoScrollBar
|
||||
|
||||
Revision 1.11 2003/03/28 23:03:38 mattias
|
||||
started TMemoScrollbar
|
||||
|
||||
|
||||
@ -45,6 +45,25 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function CompareFilenames(const Filename1, Filename2: string;
|
||||
ResolveLinks: boolean): integer;
|
||||
------------------------------------------------------------------------------}
|
||||
function CompareFilenames(const Filename1, Filename2: string;
|
||||
ResolveLinks: boolean): integer;
|
||||
var
|
||||
File1: String;
|
||||
File2: String;
|
||||
begin
|
||||
File1:=Filename1;
|
||||
File2:=Filename2;
|
||||
if ResolveLinks then begin
|
||||
File1:=ReadAllLinks(File1,false);
|
||||
File2:=ReadAllLinks(File2,false);
|
||||
end;
|
||||
Result:=CompareFilenames(File1, File1);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FilenameIsAbsolute(TheFilename: string):boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
@ -831,6 +850,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 2003/03/29 17:20:05 mattias
|
||||
added TMemoScrollBar
|
||||
|
||||
Revision 1.19 2003/03/28 23:03:38 mattias
|
||||
started TMemoScrollbar
|
||||
|
||||
|
||||
@ -15,355 +15,6 @@
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
procedure TControlScrollBar.SetPosition(Value: Integer);
|
||||
|
||||
Procedure SetVPosition;
|
||||
var
|
||||
Tmp : Longint;
|
||||
begin
|
||||
Tmp := FPosition;
|
||||
FPosition := Value;
|
||||
ScrollControlBy(0, Tmp - FPosition);
|
||||
if FControl.HandleAllocated
|
||||
and (GetScrollPos(FControl.Handle, SB_VERT) <> FPosition) then
|
||||
SetScrollPos(FControl.Handle, SB_VERT, FPosition, Visible);
|
||||
end;
|
||||
|
||||
Procedure SetHPosition;
|
||||
var
|
||||
Tmp : Longint;
|
||||
begin
|
||||
Tmp := FPosition;
|
||||
FPosition := Value;
|
||||
ScrollControlBy(Tmp - FPosition, 0);
|
||||
if FControl.HandleAllocated
|
||||
and (GetScrollPos(FControl.Handle, SB_HORZ) <> FPosition) then
|
||||
SetScrollPos(FControl.Handle, SB_HORZ, FPosition, Visible);
|
||||
end;
|
||||
|
||||
begin
|
||||
if Value < 0 then begin
|
||||
SetPosition(0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
If ControlAutoScroll then begin
|
||||
if FAutoRange < 0 then
|
||||
AutoCalcRange;
|
||||
|
||||
if Value > FAutoRange then begin
|
||||
SetPosition(FAutoRange);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Value>Range then begin
|
||||
SetPosition(Range);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Value=FPosition then exit;
|
||||
|
||||
if Kind = sbVertical then
|
||||
SetVPosition
|
||||
else
|
||||
SetHPosition;
|
||||
ControlUpdateScrollBars;
|
||||
end;
|
||||
|
||||
function TControlScrollBar.SmoothIsStored: boolean;
|
||||
begin
|
||||
Result:=FSmooth;
|
||||
end;
|
||||
|
||||
function TControlScrollBar.VisibleIsStored: boolean;
|
||||
begin
|
||||
Result:=FVisible;
|
||||
end;
|
||||
|
||||
function TControlScrollBar.GetSize: integer;
|
||||
var
|
||||
KindID: integer;
|
||||
begin
|
||||
if Kind=sbHorizontal then
|
||||
KindID:=SM_CXHSCROLL
|
||||
else
|
||||
KindID:=SM_CXVSCROLL;
|
||||
if (FControl<>nil) and (FControl.HandleAllocated) then
|
||||
Result:=LCLLinux.GetScrollBarSize(FControl.Handle,KindID)
|
||||
else
|
||||
Result:=GetSystemMetrics(KindID);
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.SetRange(Value: Integer);
|
||||
begin
|
||||
If Value < 0 then begin
|
||||
Range := 0;
|
||||
exit;
|
||||
end;
|
||||
if FRange=Value then exit;
|
||||
FRange := Value;
|
||||
ControlUpdateScrollBars;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.SetSize(const AValue: integer);
|
||||
begin
|
||||
// ToDo
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.SetVisible(Value: Boolean);
|
||||
begin
|
||||
if FVisible = Value then exit;
|
||||
FVisible := Value;
|
||||
ControlUpdateScrollBars;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.ScrollControlBy(DeltaX, DeltaY: integer);
|
||||
begin
|
||||
if FControl is TScrollingWinControl then
|
||||
TScrollingWinControl(FControl).ScrollBy(DeltaX, DeltaY)
|
||||
else begin
|
||||
writeln('TControlScrollBar.ScrollControlBy: ToDo');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.SetSmooth(Value: Boolean);
|
||||
begin
|
||||
if FSmooth = Value then exit;
|
||||
FSmooth := Value;
|
||||
ControlUpdateScrollBars;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.AutoCalcRange;
|
||||
|
||||
procedure AutoCalcVRange;
|
||||
var
|
||||
I : Integer;
|
||||
TmpRange : Longint;
|
||||
IncludeControl : Boolean;
|
||||
begin
|
||||
TmpRange := 0;
|
||||
For I := 0 to FControl.ControlCount - 1 do
|
||||
With FControl.Controls[I] do
|
||||
if Visible then begin
|
||||
IncludeControl := (Align = alTop) or (Align = alNone);
|
||||
If IncludeControl then
|
||||
TmpRange := Max(TmpRange, Top + Height);
|
||||
end;
|
||||
Range := TmpRange;
|
||||
end;
|
||||
|
||||
procedure AutoCalcHRange;
|
||||
var
|
||||
I : Integer;
|
||||
TmpRange : Longint;
|
||||
IncludeControl : Boolean;
|
||||
begin
|
||||
TmpRange := 0;
|
||||
For I := 0 to FControl.ControlCount - 1 do
|
||||
With FControl.Controls[I] do
|
||||
if Visible then begin
|
||||
IncludeControl := (Align = alLeft) or (Align = alNone);
|
||||
If IncludeControl then
|
||||
TmpRange := Max(TmpRange, Left + Width);
|
||||
end;
|
||||
Range := TmpRange;
|
||||
end;
|
||||
|
||||
begin
|
||||
if ControlAutoScroll then begin
|
||||
FVisible := True;
|
||||
if Kind = sbVertical then
|
||||
AutoCalcVRange
|
||||
else
|
||||
AutoCalcHRange;
|
||||
ControlUpdateScrollBars;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.UpdateScrollBar;
|
||||
var
|
||||
ScrollInfo: TScrollInfo;
|
||||
SBSize : Longint;
|
||||
|
||||
procedure UpdateVScroll;
|
||||
begin
|
||||
if FControl is TScrollingWinControl then
|
||||
With TScrollingWinControl(FControl) do begin
|
||||
Page := Min(ClientHeight + 1,High(Page));
|
||||
ScrollInfo.nPage := Page;
|
||||
|
||||
if Visible then begin
|
||||
If HorzScrollBar.Visible then
|
||||
SBSize := HorzScrollBar.Size
|
||||
else
|
||||
SBSize := 0;
|
||||
FAutoRange := (Range - ClientHeight)*Shortint(Range >= ClientHeight + SBSize);
|
||||
ScrollInfo.nMax := Range;
|
||||
end
|
||||
else
|
||||
ScrollInfo.nMax := 0;
|
||||
|
||||
If (Self.Visible and not FAutoScroll)
|
||||
or (FAutoScroll and (ScrollInfo.nMax > 0) and (ScrollInfo.nMax > Height))
|
||||
then
|
||||
Self.FVisible := True
|
||||
else
|
||||
Self.FVisible := False;
|
||||
if HandleAllocated then
|
||||
SetScrollInfo(Handle, SB_VERT, ScrollInfo, Self.Visible);
|
||||
end
|
||||
else
|
||||
writeln('UpdateVScroll ToDo');
|
||||
end;
|
||||
|
||||
procedure UpdateHScroll;
|
||||
begin
|
||||
if FControl is TScrollingWinControl then
|
||||
With TScrollingWinControl(FControl) do begin
|
||||
Page := Min(ClientWidth + 1,High(Page));
|
||||
ScrollInfo.nPage := Page;
|
||||
|
||||
if Visible then begin
|
||||
If VertScrollBar.Visible then
|
||||
SBSize := VertScrollBar.Size
|
||||
else
|
||||
SBSize := 0;
|
||||
FAutoRange := (Range - ClientWidth)*Shortint(Range >= ClientWidth + SBSize);
|
||||
ScrollInfo.nMax := Range;
|
||||
end
|
||||
else
|
||||
ScrollInfo.nMax := 0;
|
||||
|
||||
If (Self.Visible and not FAutoScroll)
|
||||
or (FAutoScroll and (ScrollInfo.nMax > 0) and (ScrollInfo.nMax > Width))
|
||||
then
|
||||
Self.FVisible := True
|
||||
else
|
||||
Self.FVisible := False;
|
||||
if HandleAllocated then
|
||||
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, Self.Visible);
|
||||
end
|
||||
else
|
||||
writeln('UpdateHScroll ToDo');
|
||||
end;
|
||||
|
||||
begin
|
||||
FAutoRange := 0;
|
||||
|
||||
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
||||
ScrollInfo.fMask := SIF_ALL;
|
||||
ScrollInfo.nMin := 0;
|
||||
ScrollInfo.nPos := FPosition;
|
||||
ScrollInfo.nTrackPos := FPosition;
|
||||
|
||||
if Kind = sbVertical then
|
||||
UpdateVScroll
|
||||
else
|
||||
UpdateHScroll;
|
||||
|
||||
SetPosition(ScrollInfo.nTrackPos);
|
||||
|
||||
// I am not positive that this is right, but it apeared to be when I compared
|
||||
// results to Delphi 4
|
||||
if Smooth then
|
||||
Increment := Page div 10;
|
||||
end;
|
||||
|
||||
function TControlScrollBar.ControlAutoScroll: boolean;
|
||||
begin
|
||||
if FControl is TScrollingWinControl then
|
||||
Result:=TScrollingWinControl(FControl).AutoScroll
|
||||
else
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.ScrollHandler(var Message: TLMScroll);
|
||||
var
|
||||
NewPos: Longint;
|
||||
begin
|
||||
If (csDesigning in FControl.ComponentState) then
|
||||
exit; //prevent wierdness in IDE.
|
||||
|
||||
with Message do
|
||||
begin
|
||||
NewPos := FPosition;
|
||||
case ScrollCode of
|
||||
SB_LINEUP:
|
||||
Dec(NewPos, FIncrement);
|
||||
SB_LINEDOWN:
|
||||
Inc(NewPos, FIncrement);
|
||||
SB_PAGEUP:
|
||||
Dec(NewPos, FPage);
|
||||
SB_PAGEDOWN:
|
||||
Inc(NewPos, FPage);
|
||||
SB_THUMBPOSITION, SB_THUMBTRACK:
|
||||
NewPos := Pos;
|
||||
SB_TOP:
|
||||
NewPos := 0;
|
||||
SB_BOTTOM:
|
||||
NewPos := Range;
|
||||
end;
|
||||
if NewPos < 0 then NewPos := 0;
|
||||
if NewPos > Range then NewPos := Range;
|
||||
SetPosition(NewPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.ControlUpdateScrollBars;
|
||||
begin
|
||||
if FControl is TScrollingWinControl then
|
||||
TScrollingWinControl(FControl).UpdateScrollBars
|
||||
else
|
||||
writeln('TControlScrollBar.ControlUpdateScrollBars ToDo');
|
||||
end;
|
||||
|
||||
constructor TControlScrollBar.Create(AControl: TWinControl;
|
||||
AKind: TScrollBarKind);
|
||||
begin
|
||||
Inherited Create;
|
||||
FControl := AControl;
|
||||
FKind := AKind;
|
||||
FPage := 80;
|
||||
FIncrement := 8;
|
||||
FPosition := 0;
|
||||
FRange := 0;
|
||||
FSmooth := false;
|
||||
FVisible := false;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.Assign(Source: TPersistent);
|
||||
begin
|
||||
If Source is TControlScrollBar then begin
|
||||
With Source as TControlScrollBar do begin
|
||||
Self.Increment := Increment;
|
||||
Self.Position := Position;
|
||||
Self.Range := Range;
|
||||
Self.Visible := Visible
|
||||
end;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
function TControlScrollBar.IsScrollBarVisible: Boolean;
|
||||
begin
|
||||
Result := (FControl <> nil) and FControl.HandleAllocated and
|
||||
(FControl.Visible) and (Self.Visible);
|
||||
end;
|
||||
|
||||
function TControlScrollBar.ScrollPos: Integer;
|
||||
begin
|
||||
if Visible then
|
||||
Result:=Position
|
||||
else
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
|
||||
//------------------------------------------------------------------------------
|
||||
|
||||
|
||||
procedure TScrollingWinControl.SetAutoScroll(Value: Boolean);
|
||||
begin
|
||||
if FAutoScroll <> Value then
|
||||
@ -502,7 +153,7 @@ begin
|
||||
|
||||
ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks];
|
||||
|
||||
SetBounds(0,0, 200, 200);
|
||||
SetBounds(0,0, 150, 150);
|
||||
end;
|
||||
|
||||
Destructor TScrollingWinControl.Destroy;
|
||||
|
||||
@ -753,7 +753,7 @@ type
|
||||
nMin: Integer;
|
||||
nMax: Integer;
|
||||
nPage: UInt;
|
||||
npos: Integer;
|
||||
nPos: Integer;
|
||||
nTrackPos: Integer;
|
||||
end;
|
||||
PScrollInfo = ^TScrollInfo;
|
||||
@ -1797,6 +1797,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.35 2003/03/29 17:20:05 mattias
|
||||
added TMemoScrollBar
|
||||
|
||||
Revision 1.34 2003/03/16 13:47:45 mattias
|
||||
improved rpm building and added support for 1.0.7
|
||||
|
||||
|
||||
@ -482,17 +482,17 @@ type
|
||||
{ TMemoScrollbar }
|
||||
|
||||
TMemoScrollbar = class(TControlScrollBar)
|
||||
private
|
||||
|
||||
protected
|
||||
function GetHorzScrollBar: TControlScrollBar; override;
|
||||
function GetVertScrollBar: TControlScrollBar; override;
|
||||
public
|
||||
property Increment: TScrollBarInc read FIncrement;
|
||||
property Page: TScrollBarInc read FPage;
|
||||
property Range: Integer read FRange;
|
||||
published
|
||||
property Smooth : Boolean read FSmooth write SetSmooth;// default True
|
||||
property Position: Integer read FPosition write SetPosition default 0;
|
||||
property Size: integer read GetSize write SetSize stored false;
|
||||
property Visible: Boolean read FVisible write SetVisible;// default True;
|
||||
property Increment;
|
||||
property Page;
|
||||
property Smooth;
|
||||
property Position;
|
||||
property Range;
|
||||
property Size;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
|
||||
@ -510,7 +510,7 @@ type
|
||||
procedure SetVertScrollBar(const AValue: TMemoScrollBar);
|
||||
function StoreScrollBars: boolean;
|
||||
protected
|
||||
procedure SetLines(Value : TStrings);
|
||||
procedure SetLines(const Value : TStrings);
|
||||
procedure SetWordWrap(const Value : boolean);
|
||||
procedure SetScrollBars(const Value : TScrollStyle);
|
||||
public
|
||||
@ -1420,6 +1420,7 @@ end;
|
||||
{$I customcheckbox.inc}
|
||||
|
||||
{$I scrollbar.inc}
|
||||
{$I memoscrollbar.inc}
|
||||
{$I memo.inc}
|
||||
{$I memostrings.inc}
|
||||
|
||||
@ -1443,6 +1444,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.86 2003/03/29 17:20:05 mattias
|
||||
added TMemoScrollBar
|
||||
|
||||
Revision 1.85 2003/03/28 23:03:38 mattias
|
||||
started TMemoScrollbar
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user