You've already forked lazarus-ccr
20070107 release of Orpheus - initial commit to SVN.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
224
components/orpheus/ovctcbox.pas
Normal file
224
components/orpheus/ovctcbox.pas
Normal file
@@ -0,0 +1,224 @@
|
||||
{*********************************************************}
|
||||
{* OVCTCBOX.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 ovctcbox;
|
||||
{-Orpheus Table Cell - Check box type}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
|
||||
SysUtils, Graphics, Classes, Controls, StdCtrls,
|
||||
OvcTCmmn, OvcTCell, OvcTGRes, OvcTCGly;
|
||||
|
||||
type
|
||||
TOvcTCCustomCheckBox = class(TOvcTCCustomGlyph)
|
||||
protected {private}
|
||||
{.Z+}
|
||||
FAllowGrayed : boolean;
|
||||
|
||||
FatherValue : Integer;
|
||||
{.Z-}
|
||||
|
||||
protected
|
||||
{.Z+}
|
||||
procedure SetAllowGrayed(AG : boolean);
|
||||
|
||||
procedure GlyphsHaveChanged(Sender : TObject);
|
||||
procedure tcPaint(TableCanvas : TCanvas;
|
||||
const CellRect : TRect;
|
||||
RowNum : TRowNum;
|
||||
ColNum : TColNum;
|
||||
const CellAttr : TOvcCellAttributes;
|
||||
Data : pointer); override;
|
||||
{.Z-}
|
||||
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
|
||||
function CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean; override;
|
||||
|
||||
procedure SaveEditedData(Data : pointer); override;
|
||||
procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
|
||||
CellRect : TRect;
|
||||
const CellAttr : TOvcCellAttributes;
|
||||
CellStyle: TOvcTblEditorStyle;
|
||||
Data : pointer); override;
|
||||
procedure StopEditing(SaveValue : boolean;
|
||||
Data : pointer); override;
|
||||
|
||||
property AllowGrayed : boolean
|
||||
read FAllowGrayed write SetAllowGrayed;
|
||||
|
||||
end;
|
||||
|
||||
TOvcTCCheckBox = class(TOvcTCCustomCheckBox)
|
||||
published
|
||||
{properties inherited from custom ancestor}
|
||||
property AcceptActivationClick default True;
|
||||
property Access default otxDefault;
|
||||
property Adjust default otaDefault;
|
||||
property AllowGrayed default False;
|
||||
property CellGlyphs;
|
||||
property Color;
|
||||
property Hint;
|
||||
property Margin default 4;
|
||||
property ShowHint default False;
|
||||
property Table;
|
||||
property TableColor default True;
|
||||
|
||||
{events inherited from custom ancestor}
|
||||
property OnClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnOwnerDraw;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{===TOvcTCCustomCheckBox creation/destruction========================}
|
||||
constructor TOvcTCCustomCheckBox.Create(AOwner : TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
CellGlyphs.OnCfgChanged := nil;
|
||||
if (CellGlyphs.ActiveGlyphCount = 3) then
|
||||
CellGlyphs.ActiveGlyphCount := 2;
|
||||
CellGlyphs.OnCfgChanged := GlyphsHaveChanged;
|
||||
FAcceptActivationClick := true;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcTCCustomCheckBox.SetAllowGrayed(AG : boolean);
|
||||
begin
|
||||
if AG <> FAllowGrayed then
|
||||
begin
|
||||
FAllowGrayed := AG;
|
||||
if AG then
|
||||
CellGlyphs.ActiveGlyphCount := 3
|
||||
else
|
||||
CellGlyphs.ActiveGlyphCount := 2;
|
||||
tcDoCfgChanged;
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
function TOvcTCCustomCheckBox.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
|
||||
begin
|
||||
Result := CBG.GlyphCount = 3;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcTCCustomCheckBox.GlyphsHaveChanged(Sender : TObject);
|
||||
begin
|
||||
CellGlyphs.OnCfgChanged := nil;
|
||||
if FAllowGrayed then
|
||||
CellGlyphs.ActiveGlyphCount := 3
|
||||
else
|
||||
CellGlyphs.ActiveGlyphCount := 2;
|
||||
CellGlyphs.OnCfgChanged := GlyphsHaveChanged;
|
||||
tcDoCfgChanged;
|
||||
end;
|
||||
{====================================================================}
|
||||
|
||||
|
||||
{===TOvcTCCustomCheckBox painting====================================}
|
||||
procedure TOvcTCCustomCheckBox.tcPaint(TableCanvas : TCanvas;
|
||||
const CellRect : TRect;
|
||||
RowNum : TRowNum;
|
||||
ColNum : TColNum;
|
||||
const CellAttr : TOvcCellAttributes;
|
||||
Data : pointer);
|
||||
var
|
||||
B : ^TCheckBoxState absolute Data;
|
||||
Value : integer;
|
||||
begin
|
||||
if (Data = nil) then
|
||||
inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, nil)
|
||||
else
|
||||
begin
|
||||
Value := ord(B^);
|
||||
inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @Value);
|
||||
end;
|
||||
end;
|
||||
{====================================================================}
|
||||
|
||||
|
||||
{===TOvcTCCheckBox editing===========================================}
|
||||
procedure TOvcTCCustomCheckBox.SaveEditedData(Data : pointer);
|
||||
begin
|
||||
if Assigned(Data) then
|
||||
begin
|
||||
inherited SaveEditedData(@FatherValue);
|
||||
TCheckBoxState(Data^) := TCheckBoxState(FatherValue);
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcTCCustomCheckBox.StartEditing(RowNum : TRowNum; ColNum : TColNum;
|
||||
CellRect : TRect;
|
||||
const CellAttr : TOvcCellAttributes;
|
||||
CellStyle: TOvcTblEditorStyle;
|
||||
Data : pointer);
|
||||
begin
|
||||
if (Data = nil) then
|
||||
inherited StartEditing(RowNum, ColNum,
|
||||
CellRect, CellAttr, CellStyle, nil)
|
||||
else
|
||||
begin
|
||||
FatherValue := Integer(TCheckBoxState(Data^));
|
||||
inherited StartEditing(RowNum, ColNum,
|
||||
CellRect, CellAttr, CellStyle, @FatherValue);
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcTCCustomCheckBox.StopEditing(SaveValue : boolean;
|
||||
Data : pointer);
|
||||
begin
|
||||
inherited StopEditing(SaveValue, @FatherValue);
|
||||
if SaveValue and Assigned(Data) then
|
||||
TCheckBoxState(Data^) := TCheckBoxState(FatherValue);
|
||||
end;
|
||||
{====================================================================}
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user