|
申明：本源代码非本人所写，只是粘贴他人作品,目的是为了推广!
{*********************************************************************************}
{
File Name.......: DBVGrids.zip
File Description: Implementation of a Vertical DBGrid based on Vcl''''s DBGrids.pas.
Targets.........: Delphi 3.
Author Name.....: George Vavoylogiannis
EMail...........: georgev@hol.gr
WEB.............: http://users.hol.gr/~georgev
File Status.....: Freeware
Category........: Database components.
For a long time till a few months, i was trying to find a solution for
vertical grid. I found a few grid components that claimed to be vertical, but
this was far from tue.
So one day i decided to have a better look at the DBGrids.pas in Borland VCL source.
"Bit by bit" as we say in Greece i started changing the code and finally
a TRUE VERTICAL DBGRID component is what we have here.
I wonder why Borland did''''t think about this. After all it seems so SIMPLE!!!
NEW PROPERTIES
Vertical: Boolean, set to True and and the grid becomes VERTICAL
OnlyOne: Boolean, set to true if you want the grid to display only one record
at a time (the curent record).
TitlesWidth: integer, set the vertical column title''''s width.
NOTE: because all the code is duplicated from the VCL, all the classes are
redefined (TColumn, TDBGridColumns, TGridDatalink e.t.c).
The columns editor works fine except that it does not bring the fields list.
This is something that i may do in future versions but if someone find''''s a
way to solve it or even has property editor for the columns please drop me
an E-Mail.
Free to use and redistribute, but my name must
appear somewhere in the source code, or in the software.
No warranty is given by the author, expressed or implied.
WARNING! THE CODE IS PROVIDED AS IS WITH NO GUARANTEES OF ANY KIND!
USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE FOR
ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!
}
{**********************************************************************************}
unit DBVGrids;
{$R-}
interface
uses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
Graphics, Grids, DBCtrls, Db, Menus, DBGrids, Variants;
type
TColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
cvTitleCaption, cvTitleAlignment, cvTitleFont, cvImeMode, cvImeName);
TColumnValues = set of TColumnValue;
const
ColumnTitleValues = [cvTitleColor..cvTitleFont];
cm_DeferLayout = WM_USER + 100;
{ TColumn defines internal storage for column attributes. Values assigned
to properties are stored in this object, the grid- or field-based default
sources are not modified. Values read from properties are the previously
assigned value, if any, or the grid- or field-based default values if
nothing has been assigned to that property. This class also publishes the
column attribute properties for persistent storage. }
type
TColumn = class;
TCustomVDBGrid = class;
TColumnTitle = class(TPersistent)
private
FColumn: TColumn;
FCaption: string;
FFont: TFont;
FColor: TColor;
FAlignment: TAlignment;
procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment;
function GetColor: TColor;
function GetCaption: string;
function GetFont: TFont;
function IsAlignmentStored: Boolean;
function IsColorStored: Boolean;
function IsFontStored: Boolean;
function IsCaptionStored: Boolean;
procedure SetAlignment(Value: TAlignment);
procedure SetColor(Value: TColor);
procedure SetFont(Value: TFont);
procedure SetCaption(const Value: string); virtual;
protected
procedure RefreshDefaultFont;
public
constructor Create(Column: TColumn);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function DefaultAlignment: TAlignment;
function DefaultColor: TColor;
function DefaultFont: TFont;
function DefaultCaption: string;
procedure RestoreDefaults; virtual;
published
property Alignment: TAlignment read GetAlignment write SetAlignment
stored IsAlignmentStored;
property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
property Color: TColor read GetColor write SetColor stored IsColorStored;
property Font: TFont read GetFont write SetFont stored IsFontStored;
end;
TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);
TColumn = class(TCollectionItem)
private
FField: TField;
FFieldName: string;
FColor: TColor;
FWidth: Integer;
FTitle: TColumnTitle;
FFont: TFont;
FImeMode: TImeMode;
FImeName: TImeName;
FPickList: TStrings;
FPopupMenu: TPopupMenu;
FDropDownRows: Cardinal;
FButtonStyle: TColumnButtonStyle;
FAlignment: TAlignment;
FReadonly: Boolean;
FAssignedValues: TColumnValues;
procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment;
function GetColor: TColor;
function GetField: TField;
function GetFont: TFont;
function GetImeMode: TImeMode;
function GetImeName: TImeName;
function GetPickList: TStrings;
function GetReadOnly: Boolean;
function GetWidth: Integer;
function IsAlignmentStored: Boolean;
function IsColorStored: Boolean;
function IsFontStored: Boolean;
function IsImeModeStored: Boolean;
function IsImeNameStored: Boolean;
function IsReadOnlyStored: Boolean;
function IsWidthStored: Boolean;
procedure SetAlignment(Value: TAlignment); virtual;
procedure SetButtonStyle(Value: TColumnButtonStyle);
procedure SetColor(Value: TColor);
procedure SetField(Value: TField); virtual;
procedure SetFieldName(const Value: String);
procedure SetFont(Value: TFont);
procedure SetImeMode(Value: TImeMode); virtual;
procedure SetImeName(Value: TImeName); virtual;
procedure SetPickList(Value: TStrings);
procedure SetPopupMenu(Value: TPopupMenu);
procedure SetReadOnly(Value: Boolean); virtual;
procedure SetTitle(Value: TColumnTitle);
procedure SetWidth(Value: Integer); virtual;
protected
function CreateTitle: TColumnTitle; virtual;
function GetGrid: TCustomVDBGrid;
function GetDisplayName: string; override;
procedure RefreshDefaultFont;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function DefaultAlignment: TAlignment;
function DefaultColor: TColor;
function DefaultFont: TFont;
function DefaultImeMode: TImeMode;
function DefaultImeName: TImeName;
function DefaultReadOnly: Boolean;
function DefaultWidth: Integer;
procedure RestoreDefaults; virtual;
property Grid: TCustomVDBGrid read GetGrid;
property AssignedValues: TColumnValues read FAssignedValues;
property Field: TField read GetField write SetField;
published
property Alignment: TAlignment read GetAlignment write SetAlignment
stored IsAlignmentStored;
property ButtonStyle: TColumnButtonStyle read FButtonStyle write SetButtonStyle
default cbsAuto;
property Color: TColor read GetColor write SetColor stored IsColorStored;
property DropDownRows: Cardinal read FDropDownRows write FDropDownRows default 7;
property FieldName: String read FFieldName write SetFieldName;
[1] [2] [3] [4] [5] [6] [7] [8] [9] [10] ... 下一页 >> | 
