8037f9f23a
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
512 lines
16 KiB
ObjectPascal
512 lines
16 KiB
ObjectPascal
{*********************************************************}
|
|
{* OVCTBRWS.PAS 4.06 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* The contents of this file are subject to the Mozilla Public License *}
|
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
|
{* compliance with the License. You may obtain a copy of the License at *}
|
|
{* http://www.mozilla.org/MPL/ *}
|
|
{* *}
|
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
|
{* for the specific language governing rights and limitations under the *}
|
|
{* License. *}
|
|
{* *}
|
|
{* The Original Code is TurboPower Orpheus *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
{$I OVC.INC}
|
|
|
|
{$B-} {Complete Boolean Evaluation}
|
|
{$I+} {Input/Output-Checking}
|
|
{$P+} {Open Parameters}
|
|
{$T-} {Typed @ Operator}
|
|
{.W-} {Windows Stack Frame}
|
|
{$X+} {Extended Syntax}
|
|
|
|
unit ovctbrws;
|
|
{-Orpheus Table Rows array}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
|
|
SysUtils, Classes, OvcConst, OvcTCmmn, OvcSpAry;
|
|
|
|
type
|
|
TOvcTableRows = class(TPersistent)
|
|
{-Sparse array for rows}
|
|
protected {private}
|
|
{property fields}
|
|
FActiveCount : TRowNum;
|
|
FList : TOvcSparseArray;
|
|
FDefHeight : integer;
|
|
FLimit : TRowNum;
|
|
{property event fields}
|
|
FOnCfgChanged : TRowChangeNotifyEvent;
|
|
|
|
protected
|
|
{property read access}
|
|
function GetRow(RowNum : TRowNum) : TRowStyle;
|
|
function GetRowHeight(RowNum : TRowNum) : integer;
|
|
function GetRowHidden(RowNum : TRowNum) : boolean;
|
|
function GetRowIsSpecial(RowNum : TRowNum) : boolean;
|
|
{property write access}
|
|
procedure SetDefHeight(H : integer);
|
|
procedure SetRow(RowNum : TRowNum; const RS : TRowStyle);
|
|
procedure SetRowHeight(RowNum : TRowNum; H : integer);
|
|
procedure SetRowHidden(RowNum : TRowNum; H : boolean);
|
|
procedure SetLimit(RowNum : TRowNum);
|
|
|
|
{general}
|
|
procedure trDoCfgChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions);
|
|
|
|
public {protected}
|
|
procedure rwScaleHeights(M, D : integer);
|
|
|
|
property OnCfgChanged : TRowChangeNotifyEvent
|
|
write FOnCfgChanged;
|
|
|
|
public
|
|
constructor Create;
|
|
{-Create an array of row styles}
|
|
destructor Destroy; override;
|
|
{-Destroy an array of row styles}
|
|
|
|
procedure Append(const RS : TRowStyle);
|
|
{-Add row to end of current list, increment Limit}
|
|
procedure Clear;
|
|
{-Delete all row styles (reset all rows to the defaults)}
|
|
procedure Delete(RowNum : TRowNum);
|
|
{-Delete a row, move rows below it up one, decrement Limit}
|
|
procedure Exchange(const RowNum1, RowNum2 : TRowNum);
|
|
{-Exchange two rows}
|
|
procedure Insert(const RowNum : TRowNum;
|
|
const RS : TRowStyle);
|
|
{-Insert a row, move rows below it down one, increment Limit}
|
|
procedure Reset(const RowNum : TRowNum);
|
|
{-Reset a row to the defaults}
|
|
|
|
property List [RowNum : TRowNum] : TRowStyle
|
|
{-Array of row styles}
|
|
read GetRow write SetRow;
|
|
default;
|
|
|
|
{properties}
|
|
property Count : TRowNum
|
|
{-The current number of rows with explicit attributes}
|
|
read FActiveCount;
|
|
|
|
property DefaultHeight : integer
|
|
{-The default row height}
|
|
read FDefHeight write SetDefHeight;
|
|
|
|
property Height [RowNum : TRowNum] : integer
|
|
{-Array of row heights}
|
|
read GetRowHeight write SetRowHeight;
|
|
|
|
property Hidden [RowNum : TRowNum] : boolean
|
|
{-Array of row hidden flags}
|
|
read GetRowHidden write SetRowHidden;
|
|
|
|
property RowIsSpecial [RowNum : TRowNum] : boolean
|
|
read GetRowIsSpecial;
|
|
|
|
property Limit : TRowNum
|
|
{-Maximum number of rows}
|
|
read FLimit write SetLimit;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
{===Extra RowStyle routines==========================================}
|
|
function NewRowStyle(AHeight : integer; AHidden : boolean) : PRowStyle;
|
|
{-Allocate a row style on the heap}
|
|
begin
|
|
Result := New(PRowStyle);
|
|
with Result^ do
|
|
begin
|
|
Height := AHeight;
|
|
Hidden := AHidden;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function DelRow(Index : longint; Item : pointer; ExtraData : pointer) : boolean; far;
|
|
{-Iterator to delete a row style from the sparse list}
|
|
var
|
|
R : PRowStyle absolute Item;
|
|
begin
|
|
Dispose(R);
|
|
Result := true;
|
|
end;
|
|
{--------------------------------------------------------------------}
|
|
|
|
{Note: the row numbers passed to this class have a minimum limit of
|
|
zero, and an upper limit that consists of two parts. Firstly
|
|
the real upper limit is the value of Limit: if a row number
|
|
is greater than this an out-of-bounds exception is generated.
|
|
Secondly the upper limit for rows with explicit styles is
|
|
MaxSparseArrayItems, since that is the limit for the under-
|
|
lying sparse array. Generally exceeding this limit causes the
|
|
action to be ignored, no exception is generated.}
|
|
|
|
|
|
{===TOvcTableRows==========================================================}
|
|
constructor TOvcTableRows.Create;
|
|
begin
|
|
FList := TOvcSparseArray.Create;
|
|
FDefHeight := tbDefRowHeight;
|
|
FLimit := tbDefRowCount;
|
|
end;
|
|
{--------}
|
|
destructor TOvcTableRows.Destroy;
|
|
begin
|
|
if Assigned(FList) then
|
|
begin
|
|
Clear;
|
|
FList.Free;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.Append(const RS : TRowStyle);
|
|
begin
|
|
Insert(Limit, RS);
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.Clear;
|
|
var
|
|
DummyPtr : pointer;
|
|
begin
|
|
DummyPtr := nil;
|
|
FList.ForAll(DelRow, false, DummyPtr);
|
|
FList.Clear;
|
|
FActiveCount := 0;
|
|
trDoCfgChanged(0, 0, taAll);
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.Delete(RowNum : TRowNum);
|
|
var
|
|
RS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
RS := PRowStyle(FList[RowNum]);
|
|
if Assigned(RS) then
|
|
begin
|
|
Dispose(RS);
|
|
dec(FActiveCount);
|
|
end;
|
|
FList.Delete(RowNum);
|
|
Limit := Limit - 1;
|
|
trDoCfgChanged(RowNum, 0, taDelete);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.trDoCfgChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions);
|
|
{-On a change, call the notify event handler}
|
|
begin
|
|
if Assigned(FOnCfgChanged) then
|
|
FOnCfgChanged(Self, RowNum1, RowNum2, Action);
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.Exchange(const RowNum1, RowNum2 : TRowNum);
|
|
begin
|
|
if (RowNum1 < 0) or (RowNum1 >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum2 < 0) or (RowNum2 >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum1 <> RowNum2) and
|
|
(RowNum1 < OvcSpAry.MaxSparseArrayItems) and
|
|
(RowNum2 < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
FList.Exchange(RowNum1, RowNum2);
|
|
trDoCfgChanged(RowNum1, RowNum2, taExchange);
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TOvcTableRows.GetRow(RowNum : TRowNum) : TRowStyle;
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
PRS := PRowStyle(FList[RowNum])
|
|
else
|
|
PRS := nil;
|
|
if Assigned(PRS) then
|
|
begin
|
|
Result := PRS^;
|
|
if (Result.Height = UseDefHt) then
|
|
Result.Height := DefaultHeight;
|
|
end
|
|
else
|
|
with Result do
|
|
begin
|
|
Height := DefaultHeight;
|
|
Hidden := false;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TOvcTableRows.GetRowHeight(RowNum : TRowNum) : integer;
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
Result := DefaultHeight;
|
|
if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
if Assigned(PRS) then
|
|
begin
|
|
Result := PRS^.Height;
|
|
if (Result = UseDefHt) then
|
|
Result := DefaultHeight;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TOvcTableRows.GetRowHidden(RowNum : TRowNum) : boolean;
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
Result := false;
|
|
if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
if Assigned(PRS) then
|
|
Result := PRS^.Hidden;
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TOvcTableRows.GetRowIsSpecial(RowNum : TRowNum) : boolean;
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
Result := Assigned(PRS);
|
|
end
|
|
else
|
|
Result := false;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.Insert(const RowNum : TRowNum;
|
|
const RS : TRowStyle);
|
|
var
|
|
Height : integer;
|
|
begin
|
|
{note: you can insert a style at row number Limit}
|
|
if (RowNum < 0) or (RowNum > Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum >= OvcSpAry.MaxSparseArrayItems) then
|
|
TableErrorRes(SCTableMaxRows);
|
|
Height := RS.Height;
|
|
if (Height < 1) or (Height = DefaultHeight) then
|
|
Height := UseDefHt;
|
|
if (RS.Hidden = false) and (Height = UseDefHt) then
|
|
FList.Insert(RowNum, nil)
|
|
else
|
|
begin
|
|
FList.Insert(RowNum, NewRowStyle(Height, RS.Hidden));
|
|
inc(FActiveCount);
|
|
end;
|
|
Limit := Limit + 1;
|
|
trDoCfgChanged(RowNum, 0, taInsert);
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.Reset(const RowNum : TRowNum);
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
if Assigned(PRS) then
|
|
begin
|
|
Dispose(PRS);
|
|
FList[RowNum] := nil;
|
|
dec(FActiveCount);
|
|
trDoCfgChanged(RowNum, 0, taSingle);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
type
|
|
PScaleExtraData = ^TScaleExtraData;
|
|
TScaleExtraData = packed record
|
|
M, D : integer;
|
|
end;
|
|
{------}
|
|
function ScaleHeight(Index : longint; Item : pointer;
|
|
ExtraData : pointer) : boolean; far;
|
|
var
|
|
RS : PRowStyle absolute Item;
|
|
ED : PScaleExtraData absolute ExtraData;
|
|
begin
|
|
Result := true;
|
|
with RS^ do
|
|
if (Height <> UseDefHt) then
|
|
Height := MulDiv(Height, ED^.M, ED^.D);
|
|
end;
|
|
{------}
|
|
procedure TOvcTableRows.rwScaleHeights(M, D : integer);
|
|
var
|
|
ExtraData : TScaleExtraData;
|
|
begin
|
|
FDefHeight := MulDiv(FDefHeight, M, D);
|
|
if (FActiveCount > 0) then
|
|
begin
|
|
ExtraData.M := M;
|
|
ExtraData.D := D;
|
|
FList.ForAll(ScaleHeight, false, @ExtraData);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.SetDefHeight(H : integer);
|
|
begin
|
|
if (H <> FDefHeight) and (H >= 1) then
|
|
begin
|
|
FDefHeight := H;
|
|
trDoCfgChanged(0, 0, taAll);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.SetLimit(RowNum : TRowNum);
|
|
begin
|
|
if RowNum < 1 then
|
|
RowNum := 1;
|
|
if (RowNum <> FLimit) then
|
|
begin
|
|
FLimit := RowNum;
|
|
trDoCfgChanged(RowLimitChanged, 0, taGeneral);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.SetRow(RowNum : TRowNum; const RS : TRowStyle);
|
|
var
|
|
PRS : PRowStyle;
|
|
Height : integer;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
Height := RS.Height;
|
|
if (Height < 1) or (Height = DefaultHeight) then
|
|
Height := UseDefHt;
|
|
if (RS.Hidden = false) and (Height = UseDefHt) then
|
|
Reset(RowNum)
|
|
else
|
|
begin
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
if Assigned(PRS) then
|
|
PRS^ := RS
|
|
else
|
|
begin
|
|
FList[RowNum] := NewRowStyle(Height, RS.Hidden);
|
|
inc(FActiveCount);
|
|
end;
|
|
trDoCfgChanged(RowNum, 0, taSingle);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.SetRowHeight(RowNum : TRowNum; H : integer);
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
if (H < 1) or (H = DefaultHeight) then
|
|
H := UseDefHt;
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
if Assigned(PRS) then
|
|
begin
|
|
if (H <> PRS^.Height) then
|
|
begin
|
|
if (H = UseDefHt) then
|
|
if not PRS^.Hidden then
|
|
begin
|
|
Dispose(PRS);
|
|
FList[RowNum] := nil;
|
|
dec(FActiveCount);
|
|
end
|
|
else
|
|
PRS^.Height := UseDefHt
|
|
else
|
|
PRS^.Height := H;
|
|
trDoCfgChanged(RowNum, 0, taSingle);
|
|
end;
|
|
end
|
|
else if (H <> UseDefHt) then {only create new style if not default}
|
|
begin
|
|
FList[RowNum] := NewRowStyle(H, false);
|
|
inc(FActiveCount);
|
|
trDoCfgChanged(RowNum, 0, taSingle);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcTableRows.SetRowHidden(RowNum : TRowNum; H : boolean);
|
|
var
|
|
PRS : PRowStyle;
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= Limit) then
|
|
TableErrorRes(SCTableRowOutOfBounds);
|
|
if (RowNum < OvcSpAry.MaxSparseArrayItems) then
|
|
begin
|
|
PRS := PRowStyle(FList[RowNum]);
|
|
if Assigned(PRS) then
|
|
begin
|
|
if (H <> PRS^.Hidden) then
|
|
begin
|
|
if (not H) and (PRS^.Height = UseDefHt) then
|
|
begin
|
|
Dispose(PRS);
|
|
FList[RowNum] := nil;
|
|
dec(FActiveCount);
|
|
end
|
|
else
|
|
PRS^.Hidden := H;
|
|
trDoCfgChanged(RowNum, 0, taSingle);
|
|
end;
|
|
end
|
|
else if H then {only create new style if hidden}
|
|
begin
|
|
FList[RowNum] := NewRowStyle(UseDefHt, H);
|
|
inc(FActiveCount);
|
|
trDoCfgChanged(RowNum, 0, taSingle);
|
|
end;
|
|
end;
|
|
end;
|
|
{====================================================================}
|
|
|
|
|
|
end.
|