申明:本源代码非本人所写,只是粘贴他人作品,目的是为了推广! {*********************************************************************************} { 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] ... 下一页 >> [聊天工具]让你的MSN Messenger好友看到你在干嘛__天极Yesky [聊天工具]让你的Foxmail不再撒谎 [聊天工具]IncrediMail让你的E-mail也作秀 [常用软件]让你的Blog拥有Google日历 [常用软件][网络]Stuff Plug 让你的MSN聊天与众不同 [Delphi程序]让你的DBGridEh的Column自动适应宽度
|