能把StringGrid的单元格变成ListView, 或 找好用的财务软件
财务软件版1楼: 能把StringGrid的单元格变成ListView, 或者ListBox类型吗？ 谢谢!
property Color: TColor read GetColor write SetColor stored IsColorStored;
property Font: TFont read GetFont write SetFont stored IsFontStored;
end;
TImpColumnButtonStyle = (cbsPicklist, cbsEllipsis, cbsNone);
TImpColumnEditStyle=(cvString,cvInteger,cvDouble);
TImpColumn = class(TCollectionItem)
private
FColor: TColor;
FWidth: Integer;
FTitle: TImpColumnTitle;
FFont: TFont;
FImeMode: TImeMode;
FImeName: TImeName;
FPickList: TStrings;
// FPopupMenu: TPopupMenu;
FDropDownRows: Cardinal;
FButtonStyle: TImpColumnButtonStyle;
FAlignment: TAlignment;
FReadonly: Boolean;
FAssignedValues: TImpColumnValues;
FEditStyle:TImpColumnEditStyle;
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: TImpColumnButtonStyle);
procedure SetEditStyle(Value: TImpColumnEditStyle);
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: TImpColumnTitle);
procedure SetWidth(Value: Integer); virtual;
protected
function CreateTitle: TImpColumnTitle; virtual;
function GetGrid: TsuiStringGrid;
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: TsuiStringGrid read GetGrid;
property AssignedValues: TImpColumnValues read FAssignedValues;
// property Field: TField read GetField write SetField;
published
property Alignment: TAlignment read GetAlignment write SetAlignment
stored IsAlignmentStored;
property ButtonStyle: TImpColumnButtonStyle read FButtonStyle write SetButtonStyle
default cbsNone;
property EditStyle: TImpColumnEditStyle read FEditStyle write SetEditStyle
default cvString;
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;
property Font: TFont read GetFont write SetFont stored IsFontStored;
property ImeMode: TImeMode read GetImeMode write SetImeMode stored IsImeModeStored;
property ImeName: TImeName read GetImeName write SetImeName stored IsImeNameStored;
property PickList: TStrings read GetPickList write SetPickList;
// property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly
stored IsReadOnlyStored;
property Title: TImpColumnTitle read FTitle write SetTitle;
property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
end;
TImpGridColumns = class(TCollection)
private
FGrid: TsuiStringGrid;
function GetCount:Integer;
function GetState: TImpGridColumnsState;
function GeTImpColumn(Index: Integer): TImpColumn;
procedure SeTImpColumn(Index: Integer; Value: TImpColumn);
procedure SetState(NewState: TImpGridColumnsState);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
constructor Create(Grid: TsuiStringGrid; ColumnClass: TImpColumnClass);
function Add: TImpColumn;
procedure LoadFromFile(const Filename: string);
procedure LoadFromStream(S: TStream);
procedure RestoreDefaults;
procedure RebuildColumns;
procedure SaveToFile(const Filename: string);
procedure SaveToStream(S: TStream);
property State: TImpGridColumnsState read GetState write SetState;
property Grid: TsuiStringGrid read FGrid;
property Items[Index: Integer]: TImpColumn read GeTImpColumn write SeTImpColumn; default;
property Count: integer read GetCount;
end;
{$IFDEF SUIPACK_D5}
TsuiCustomDrawGrid = class(TDrawGrid)
{$ENDIF}
{$IFDEF SUIPACK_D6UP}
TsuiCustomDrawGrid = class(TCustomDrawGrid)
{$ENDIF}
private
m_BorderColor : TColor;
m_FocusedColor : TColor;
m_SelectedColor : TColor;
m_UIStyle : TsuiUIStyle;
m_FileTheme : TsuiFileTheme;
m_FixedFontColor: TColor;
m_MouseDown : Boolean;
// scroll bar
m_VScrollBar : TsuiScrollBar;
m_HScrollBar : TsuiScrollBar;
m_SelfChanging : Boolean;
m_UserChanging : Boolean;
procedure SetHScrollBar(const Value: TsuiScrollBar);
procedure SetVScrollBar(const Value: TsuiScrollBar);
procedure OnHScrollBarChange(Sender : TObject);
procedure OnVScrollBarChange(Sender : TObject);
procedure UpdateScrollBars();
procedure UpdateScrollBarsPos();
procedure UpdateInnerScrollBars();
procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
procedure SetBorderColor(const Value: TColor);
procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
procedure SetUIStyle(const Value: TsuiUIStyle);
procedure SetFocusedColor(const Value: TColor);
procedure SetSelectedColor(const Value: TColor);
procedure SetFixedFontColor(const Value: TColor);
function GetCtl3D: Boolean;
procedure SetFontColor(const Value: TColor);
function GetFontColor: TColor;
procedure SetFileTheme(const Value: TsuiFileTheme);
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Paint(); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create (AOwner: TComponent); override;
published
property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
property Color;
property FixedColor;
property BorderColor : TColor read m_BorderColor write SetBorderColor;
property FocusedColor : TColor read m_FocusedColor write SetFocusedColor;
property SelectedColor : TColor read m_SelectedColor write SetSelectedColor;
property FixedFontColor : TColor read m_FixedFontColor write SetFixedFontColor;
property FontColor : TColor read GetFontColor write SetFontColor;
property Ctl3D read GetCtl3D;
// scroll bar
property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;
end;
TsuiDrawGrid = class(TsuiCustomDrawGrid)
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property ColCount;
property Constraints;
property DefaultColWidth;
property DefaultRowHeight;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedCols;
property RowCount;
property FixedRows;
property Font;
property GridLineWidth;
property Options;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollBars;
property ShowHint;
property TabOrder;
property Visible;
property VisibleColCount;
property VisibleRowCount;
property OnClick;
property OnColumnMoved;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawCell;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetEditMask;
property OnGetEditText;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnRowMoved;
property OnSelectCell;
property OnSetEditText;
property OnStartDock;
property OnStartDrag;
property OnTopLeftChanged;
end;
TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
TPopupListbox = class;
TsuiStringGrid = class(TStringGrid)
private
m_BorderColor : TColor;
m_FocusedColor : TColor;
m_SelectedColor : TColor;
m_UIStyle : TsuiUIStyle;
m_FixedFontColor: TColor;
m_FileTheme : TsuiFileTheme;
m_MouseDown : Boolean;
// scroll bar
m_VScrollBar : TsuiScrollBar;
m_HScrollBar : TsuiScrollBar;
m_SelfChanging : Boolean;
m_UserChanging : Boolean;
fOntoomuch:TnotifyEvent;
fOnNewRow:TnotifyEvent;
fOnElippsisclicked:TImpgridCellEvent;
fOnPicklistDropdown:TImpgridDropDownEvent;
fToomuch:boolean;
function GetColCount: Integer;
procedure SetColCount(Col: LongInt);
procedure Editbuttonclick;
procedure SetHScrollBar(const Value: TsuiScrollBar);
procedure SetVScrollBar(const Value: TsuiScrollBar);
procedure OnHScrollBarChange(Sender : TObject);
procedure OnVScrollBarChange(Sender : TObject);
procedure UpdateScrollBars();
procedure UpdateScrollBarsPos();
procedure UpdateInnerScrollBars();
procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
procedure CMBIDIMODECHANGED(var Msg : TMessage); message CM_BIDIMODECHANGED;
procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
procedure SetBorderColor(const Value: TColor);
procedure SetFocusedColor(const Value: TColor);
procedure SetSelectedColor(const Value: TColor);
procedure SetUIStyle(const Value: TsuiUIStyle);
procedure SetFixedFontColor(const Value: TColor);
function GetCtl3D: Boolean;
procedure SetFontColor(const Value: TColor);
function GetFontColor: TColor;
procedure SetFileTheme(const Value: TsuiFileTheme);
function GetBGColor: TColor;
procedure SetBGColor(const Value: TColor);
function GetFixedBGColor: TColor;
procedure SetFixedBGColor(const Value: TColor);
procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
protected
function GetSelLength: Integer; virtual;
function GetSelStart: Integer; virtual;
procedure SetSelLength(Value: Integer); virtual;
procedure SetSelStart(Value: Integer); virtual;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Paint(); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
function CreateEditor: TInplaceEdit; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure KeyPress(var Key: Char); override;
public
Columns: TImpGridColumns;
constructor Create (AOwner: TComponent); override;
property SelLength: Integer read GetSelLength write SetSelLength;
property SelStart: Integer read GetSelStart write SetSelStart;
published
property OnTooMuchrows : TNotifyEvent read fOntoomuch write fOntoomuch;
property OnNewRow : TNotifyEvent read fOnNewRow write fOnNewRow;
property OnElippsisclicked : TImpGridCellEvent read fOnElippsisclicked write fOnElippsisclicked;
property OnPicklistDropdown : TImpGridDropdownEvent read fOnPicklistDropdown write fOnPicklistDropdown;
property ColCount: Longint read GetColCount write SetColCount default 5;
property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
property BGColor : TColor read GetBGColor write SetBGColor;
property BorderColor : TColor read m_BorderColor write SetBorderColor;
property FocusedColor : TColor read m_FocusedColor write SetFocusedColor;
property SelectedColor : TColor read m_SelectedColor write SetSelectedColor;
property FixedFontColor : TColor read m_FixedFontColor write SetFixedFontColor;
property FixedBGColor : TColor read GetFixedBGColor write SetFixedBGColor;
property FontColor : TColor read GetFontColor write SetFontColor;
property Ctl3D read GetCtl3D;
// scroll bar
property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;
end;
TImpGridInplaceEdit = class(TInplaceEdit)
private
FButtonWidth: Integer;
//FDataList: TDBLookupListBox;
FPickList: TPopupListbox;
FActiveList: TWinControl;
//FLookupSource: TDatasource;
FEditStyle: TEditStyle;
FListVisible: Boolean;
FTracking: Boolean;
FPressed: Boolean;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetEditStyle(Value: TEditStyle);
procedure StopTracking;
procedure TrackButton(X,Y: Integer);
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
procedure WMPaint(var Message: TWMPaint); message wm_Paint;
procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
protected
procedure BoundsChanged; override;
procedure CloseUp(Accept: Boolean);
procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
procedure DropDown;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure PaintWindow(DC: HDC); override;
procedure UpdateContents; override;
procedure WndProc(var Message: TMessage); override;
property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
property ActiveList: TWinControl read FActiveList write FActiveList;
//property DataList: TDBLookupListBox read FDataList;
property PickList: TPopupListbox read FPickList;
public
constructor Create(Owner: TComponent); override;
end;
{ TPopupListbox }
TPopupListbox = class(TCustomListbox)
private
FSearchText: String;
FSearchTickCount: Longint;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure KeyPress(var Key: Char); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
end;
const
ColumnTitleValues = [cvTitleColor..cvTitleFont];
cm_DeferLayout = WM_USER + 100;
implementation
uses SUIPublic, SUIProgressBar;
var
DrawBitmap: TBitmap;
UserCount: Integer;
procedure UsesBitmap;
begin
if UserCount = 0 then
DrawBitmap := TBitmap.Create;
Inc(UserCount);
end;
procedure ReleaseBitmap;
begin
Dec(UserCount);
if UserCount = 0 then DrawBitmap.Free;
end;
function Max(X, Y: Integer): Integer;
begin
Result := Y;
if X > Y then Result := X;
end;
procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
M: TMsg;
begin
M.Message := 0;
if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
PostQuitMessage(M.wparam);
end;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
B, R: TRect;
I, Left: Integer;
begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
end
else begin { Use FillRect and Drawtext for dithered colors }
DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;
end;
end;
{ TsuiCustomDrawGrid }
procedure TsuiCustomDrawGrid.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.CMVisibleChanged(var Msg: TMEssage);
begin
inherited;
if not Visible then
begin
if m_VScrollBar <> nil then
m_VScrollBar.Visible := Visible;
if m_HScrollBar <> nil then
m_HScrollBar.Visible := Visible;
end
else
UpdateScrollBarsPos();
end;
constructor TsuiCustomDrawGrid.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
BorderStyle := bsNone;
BorderWidth := 1;
UIStyle := GetSUIFormStyle(AOwner);
m_MouseDown := false;
FocusedColor := clGreen;
SelectedColor := clYellow;
ParentCtl3D := false;
inherited Ctl3D := false;
end;
procedure TsuiCustomDrawGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
R : TRect;
begin
if not DefaultDrawing then
begin
inherited;
exit;
end;
R := ARect;
try
if gdFixed in AState then
Exit;
if gdSelected in AState then
begin
Canvas.Brush.Color := m_SelectedColor;
end;
if gdFocused in AState then
begin
Canvas.Brush.Color := m_FocusedColor;
end;
if AState = [] then
Canvas.Brush.Color := Color;
Canvas.FillRect(R);
finally
inherited;
end;
end;
function TsuiCustomDrawGrid.GetCtl3D: Boolean;
begin
Result := false;
end;
function TsuiCustomDrawGrid.GetFontColor: TColor;
begin
Result := Font.Color;
end;
procedure TsuiCustomDrawGrid.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (
(Operation = opRemove) and
(AComponent = m_HScrollBar)
)then
begin
m_HScrollBar := nil;
UpdateInnerScrollBars();
end;
if (
(Operation = opRemove) and
(AComponent = m_VScrollBar)
)then
begin
m_VScrollBar := nil;
UpdateInnerScrollBars();
end;
if (
(Operation = opRemove) and
(AComponent = m_FileTheme)
)then
begin
m_FileTheme := nil;
SetUIStyle(SUI_THEME_DEFAULT);
end;
end;
procedure TsuiCustomDrawGrid.OnHScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, m_HScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiCustomDrawGrid.OnVScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, m_VScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiCustomDrawGrid.Paint;
begin
inherited;
DrawControlBorder(self, m_BorderColor, Color);
end;
procedure TsuiCustomDrawGrid.SetBorderColor(const Value: TColor);
begin
m_BorderColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetFileTheme(const Value: TsuiFileTheme);
begin
m_FileTheme := Value;
SetUIStyle(m_UIStyle);
end;
procedure TsuiCustomDrawGrid.SetFixedFontColor(const Value: TColor);
begin
m_FixedFontColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetFocusedColor(const Value: TColor);
begin
m_FocusedColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetFontColor(const Value: TColor);
begin
Font.Color := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetHScrollBar(const Value: TsuiScrollBar);
begin
if m_HScrollBar = Value then
Exit;
if m_HScrollBar <> nil then
begin
m_HScrollBar.OnChange := nil;
m_HScrollBar.LineButton := 0;
m_HScrollBar.Max := 100;
m_HScrollBar.Enabled := true;
end;
m_HScrollBar := Value;
if m_HScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_HScrollBar.Orientation := suiHorizontal;
m_HScrollBar.OnChange := OnHScrollBarChange;
m_HScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.SetSelectedColor(const Value: TColor);
begin
m_SelectedColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetUIStyle(const Value: TsuiUIStyle);
var
OutUIStyle : TsuiUIStyle;
begin
m_UIStyle := Value;
if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
begin
BorderColor := m_FileTheme.GetColor(SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := m_FileTheme.GetColor(SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := m_FileTheme.GetColor(SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end
else
begin
BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end;
if m_VScrollBar <> nil then
m_VScrollBar.UIStyle := OutUIStyle;
if m_HScrollBar <> nil then
m_HScrollBar.UIStyle := OutUIStyle;
end;
procedure TsuiCustomDrawGrid.SetVScrollBar(const Value: TsuiScrollBar);
begin
if m_VScrollBar = Value then
Exit;
if m_VScrollBar <> nil then
begin
m_VScrollBar.OnChange := nil;
m_VScrollBar.LineButton := 0;
m_VScrollBar.Max := 100;
m_VScrollBar.Enabled := true;
end;
m_VScrollBar := Value;
if m_VScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_VScrollBar.Orientation := suiVertical;
m_VScrollBar.OnChange := OnVScrollBArChange;
m_VScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.UpdateInnerScrollBars;
begin
if (m_VScrollBar <> nil) and (m_HScrollBar <> nil) then
ScrollBars := ssBoth
else if (m_VScrollBar <> nil) and (m_HScrollBar = nil) then
ScrollBars := ssVertical
else if (m_HScrollBar <> nil) and (m_VScrollBar = nil) then
ScrollBars := ssHorizontal
else
ScrollBars := ssNone;
end;
procedure TsuiCustomDrawGrid.UpdateScrollBars;
var
info : tagScrollInfo;
barinfo : tagScrollBarInfo;
L2R : Boolean;
begin
if m_UserChanging then
Exit;
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
m_SelfChanging := true;
if m_HScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), barinfo) then
begin
m_HScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_HScrollBar.LineButton := 0;
m_HScrollBar.Enabled := false;
m_HScrollBar.SliderVisible := false;
end
else
begin
m_HScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_HScrollBar.SmallChange := 3 * m_HScrollBar.PageSize;
m_HScrollBar.Enabled := true;
m_HScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_HORZ, info);
m_HScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_HScrollBar.Min := info.nMin;
if L2R then
m_HScrollBar.Position := info.nPos
else
m_HScrollBar.Position := m_HScrollBar.Max - info.nPos;
end;
if m_VScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), barinfo) then
begin
m_VScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_VScrollBar.LineButton := 0;
m_VScrollBar.Enabled := false;
m_VScrollBar.SliderVisible := false;
end
else
begin
m_VScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_VScrollBar.Enabled := true;
m_VScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_VERT, info);
m_VScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_VScrollBar.Min := info.nMin;
m_VScrollBar.Position := info.nPos;
end;
m_SelfChanging := false;
end;
procedure TsuiCustomDrawGrid.UpdateScrollBarsPos;
var
L2R : Boolean;
begin
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
if m_HScrollBar <> nil then
begin
if Height < m_HScrollBar.Height then
m_HScrollBar.Visible := false
else
m_HScrollBar.Visible := true;
if L2R then
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
else
m_HScrollBar.Width := Width - 1
end
else
begin
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
begin
m_HScrollBar.Left := Left + m_VScrollBar.Width + 1;
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
end
else
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Width := Width - 1;
end;
end;
end;
if m_VScrollBar <> nil then
begin
if Width < m_VScrollBar.Width then
m_VScrollBar.Visible := false
else
m_VScrollBar.Visible := true;
if L2R then
begin
m_VScrollBar.Left := Left + Width - m_VScrollBar.Width - 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end
else
begin
m_VScrollBar.Left := Left + 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end;
end;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMClear(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMCut(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMEARSEBKGND(var Msg: TMessage);
begin
Paint();
end;
procedure TsuiCustomDrawGrid.WMHSCROLL(var Message: TWMHScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMLBUTTONDOWN(var Message: TMessage);
begin
inherited;
m_MouseDown := true;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMLButtonUp(var Message: TMessage);
begin
inherited;
m_MouseDown := false;
end;
procedure TsuiCustomDrawGrid.WMMOUSEMOVE(var Message: TMessage);
begin
inherited;
if m_MouseDown then UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMMOUSEWHEEL(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMMOVE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.WMPaste(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMSetText(var Message: TWMSetText);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMSIZE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.WMUndo(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMVSCROLL(var Message: TWMVScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
{ TsuiStringGrid }
procedure TsuiStringGrid.CMBIDIMODECHANGED(var Msg: TMessage);
var
L2R : Boolean;
info : tagScrollInfo;
begin
inherited;
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
if (not L2R) and (m_HScrollBar <> nil) then
begin
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_HORZ, info);
m_HScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_HScrollBar.Min := info.nMin;
m_HScrollBar.Position := m_HScrollBar.Max - info.nPos
end;
end;
procedure TsuiStringGrid.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.CMVisibleChanged(var Msg: TMEssage);
begin
inherited;
if not Visible then
begin
if m_VScrollBar <> nil then
m_VScrollBar.Visible := Visible;
if m_HScrollBar <> nil then
m_HScrollBar.Visible := Visible;
end
else
UpdateScrollBarsPos();
end;
constructor TsuiStringGrid.Create(AOwner: TComponent);
var
i:integer;
begin
inherited;
Columns := TImpGridColumns.Create(self,TImpColumn);
For i := 1 to 5 do Columns.add;
ControlStyle := ControlStyle + [csOpaque];
BorderStyle := bsNone;
BorderWidth := 1;
UIStyle := GetSUIFormStyle(AOwner);
FocusedColor := clLime;
SelectedColor := clYellow;
ParentCtl3D := false;
m_MouseDown := false;
inherited Ctl3D := false;
end;
function TsuiStringGrid.CreateEditor: TInplaceEdit;
begin
Result := TImpGridInplaceEdit.Create(Self);
end;
procedure TsuiStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
function RowIsMultiSelected: Boolean;
var
Index: Integer;
begin
Result :=false;
{(dgMultiSelect in Options) and Datalink.Active and
FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);}
end;
var
OldActive: Integer;
Indicator: Integer;
Highlight: Boolean;
Value: string;
DrawColumn: TImpColumn;
FrameOffs: Byte;
MultiSelected: Boolean;
R : TRect;
begin
if not DefaultDrawing then
begin
inherited;
end
else
begin
R := ARect;
try
if not( gdFixed in AState) then
begin
if gdSelected in AState then
begin
Canvas.Brush.Color := m_SelectedColor;
end;
if gdFocused in AState then
begin
Canvas.Brush.Color := m_FocusedColor;
end;
if AState = [] then
Canvas.Brush.Color := Color;
Canvas.FillRect(R);
end;
finally
if gdFixed in AState then
begin
Canvas.Font.Color := m_FixedFontColor;
Canvas.TextRect(ARect, ARect.Left + 2, ARect.Top + 2, Cells[ACol, ARow]);
end;
inherited;
end;
end;
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
{ Dec(ARow, FTitleOffset);
Dec(ACol, FIndicatorOffset); }
if (gdFixed in AState) then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
with Canvas do
begin
DrawColumn := Columns[ACol];
if gdFixed in AState then
begin
Font := DrawColumn.Title.Font;
Brush.Color := DrawColumn.Title.Color;
end
else
begin
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color;
{ if gdSelected in AState then
begin
Brush.Color := m_SelectedColor;
end;
if gdFocused in AState then
begin
Brush.Color := m_FocusedColor;
end;
if AState = [] then
Canvas.Brush.Color := Color;
} // Canvas.FillRect(R);
end;
with DrawColumn do
WriteText(Canvas, ARect, FrameOffs, FrameOffs, cells[Acol,Arow], Alignment)
end;
if (gdFixed in AState) then
begin
InflateRect(ARect, 1, 1);
Canvas.Font.Color := m_FixedFontColor;
Canvas.TextRect(ARect, ARect.Left + 2, ARect.Top + 2, Cells[ACol, ARow]);
if ARow < 1 then with DrawColumn.Title do
WriteText(Canvas, ARect, FrameOffs, FrameOffs, Caption, Alignment);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_FLAT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT or BF_FLAT);
end;
end;
procedure TsuiStringGrid.Editbuttonclick;
begin
if assigned(OnElippsisclicked) then OnElippsisclicked(self,col,row)
end;
function TsuiStringGrid.GetBGColor: TColor;
begin
Result := Color;
end;
function TsuiStringGrid.GetColCount: Integer;
begin
result := inherited colcount;
end;
function TsuiStringGrid.GetCtl3D: Boolean;
begin
Result := false;
end;
function TsuiStringGrid.GetFixedBGColor: TColor;
begin
Result := FixedColor;
end;
function TsuiStringGrid.GetFontColor: TColor;
begin
Result := Font.Color;
end;
function TsuiStringGrid.GetSelLength: Integer;
var
Selection: TSelection;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
Result := Selection.EndPos - Selection.StartPos;
end;
function TsuiStringGrid.GetSelStart: Integer;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
end;
procedure TsuiStringGrid.KeyDown(var Key: Word; Shift: TShiftState);
var coll,roww,i:integer;
begin
coll := col;
roww := row;
if key = vk_tab then begin
if not (ssAlt in Shift) then
if ssShift in Shift then
begin
Dec(coll);
if coll < FixedCols then
begin
coll := ColCount - 1;
Dec(roww);
if roww < FixedRows then roww := RowCount - 1;
end;
Shift := [];
end
else
begin
Inc(coll);
if coll >= ColCount then
begin
coll := FixedCols;
Inc(roww);
if roww >= RowCount then
begin
if (rowcount+1)*(Defaultrowheight+Gridlinewidth) > height then
begin
if not ftoomuch then if assigned(fOntoomuch) then fOntoomuch(self);
ftoomuch := true;
end else ftoomuch := false;
rowcount := rowcount +1;
if assigned(fOnNewRow) then fOnNewRow(self);
if colcount <> 0 then for i := 0 to colcount-1 do begin
cells[i,roww] := ＇＇＇＇;
end;
end;
end;
end;
end;
inherited keydown(Key,Shift);
end;
procedure TsuiStringGrid.KeyPress(var Key: Char);
var
myEdit:TEdit;
begin
if (Key=#27) or (Key=#8) then exit;
if Columns.Items[Col].EditStyle=cvInteger then
begin
if not (Key in [＇＇0＇＇..＇＇9＇＇]) then Key:=#0;
end
else if Columns.Items[Col].EditStyle=cvDouble then
begin
if not (Key in [＇＇0＇＇..＇＇9＇＇,＇＇.＇＇] ) then Key:=#0;
if (Key = ＇＇.＇＇) then
begin
if (Pos(＇＇.＇＇,Cells[Col,Row])>0) then
begin
if (SelStart+SelLength=Pos(＇＇.＇＇,Cells[Col,Row])) then Key:=#0;
if SelLength=0 then Key:=#0;
end;
if SelStart=0 then Key:=#0;
if (SelStart>0) then
if length(Cells[Col,Row])-SelStart -SelLength>2 then Key:=#0;
end;
if (SelStart>0) and (SelLength=0) then
if (pos(＇＇.＇＇,Cells[Col,Row])>0) and (SelStart>=pos(＇＇.＇＇,Cells[Col,Row])) then
if length(Cells[Col,Row])-pos(＇＇.＇＇,Cells[Col,Row])>=2 then Key:=#0;
end;
inherited;
end;
procedure TsuiStringGrid.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (
(Operation = opRemove) and
(AComponent = m_FileTheme)
)then
begin
m_FileTheme := nil;
SetUIStyle(SUI_THEME_DEFAULT);
end;
if (
(Operation = opRemove) and
(AComponent = m_HScrollBar)
)then
begin
m_HScrollBar := nil;
UpdateInnerScrollBars();
end;
if (
(Operation = opRemove) and
(AComponent = m_VScrollBar)
)then
begin
m_VScrollBar := nil;
UpdateInnerScrollBars();
end;
end;
procedure TsuiStringGrid.OnHScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, m_HScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiStringGrid.OnVScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, m_VScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiStringGrid.Paint;
begin
inherited;
DrawControlBorder(self, m_BorderColor, Color, false);
end;
procedure TsuiStringGrid.SetBGColor(const Value: TColor);
begin
Color := Value;
end;
procedure TsuiStringGrid.SetBorderColor(const Value: TColor);
begin
m_BorderColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetColCount(Col: Integer);
var oldcol:Longint;
begin
oldcol := inherited Colcount;
if oldcol <> col then begin
if col > oldcol then begin
while oldcol < col do begin
columns.add;
inc(oldcol);
end;
end
else
begin
while oldcol > col do begin
columns.items[columns.count-1].free;
dec(oldcol);
end;
end;
end;
inherited colcount := col;
end;
procedure TsuiStringGrid.SetEditText(ACol, ARow: Integer;
const Value: string);
begin
if Columns.Items[Acol].EditStyle=cvInteger then
begin
try
if trim(Value)<>＇＇＇＇ then strtoint(Value);
except
on e:exception do Cells[ACol, ARow] :=＇＇0＇＇;
end;
end
else if Columns.Items[Acol].EditStyle=cvDouble then
begin
try
if trim(Value)<>＇＇＇＇ then strtofloat(Value);
except
on e:exception do Cells[ACol, ARow] :=＇＇0.00＇＇;
end;
end
else Cells[ACol, ARow] := Value;
inherited;
end;
procedure TsuiStringGrid.SetFileTheme(const Value: TsuiFileTheme);
begin
m_FileTheme := Value;
SetUIStyle(m_UIStyle);
end;
procedure TsuiStringGrid.SetFixedBGColor(const Value: TColor);
begin
FixedColor := Value;
end;
procedure TsuiStringGrid.SetFixedFontColor(const Value: TColor);
begin
m_FixedFontColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetFocusedColor(const Value: TColor);
begin
m_FocusedColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetFontColor(const Value: TColor);
begin
Font.Color := Value;
Repaint();
end;
procedure TsuiStringGrid.SetHScrollBar(const Value: TsuiScrollBar);
begin
if m_HScrollBar = Value then
Exit;
if m_HScrollBar <> nil then
begin
m_HScrollBar.OnChange := nil;
m_HScrollBar.LineButton := 0;
m_HScrollBar.Max := 100;
m_HScrollBar.Enabled := true;
end;
m_HScrollBar := Value;
if m_HScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_HScrollBar.Orientation := suiHorizontal;
m_HScrollBar.OnChange := OnHScrollBarChange;
m_HScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.SetSelectedColor(const Value: TColor);
begin
m_SelectedColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetSelLength(Value: Integer);
var
Selection: TSelection;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
Selection.EndPos := Selection.StartPos + Value;
SendMessage(Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
SendMessage(Handle, EM_SCROLLCARET, 0,0);
end;
procedure TsuiStringGrid.SetSelStart(Value: Integer);
begin
SendMessage(Handle, EM_SETSEL, Value, Value);
end;
procedure TsuiStringGrid.SetUIStyle(const Value: TsuiUIStyle);
var
OutUIStyle : TsuiUIStyle;
begin
m_UIStyle := Value;
if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
begin
BorderColor := m_FileTheme.GetColor(SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := m_FileTheme.GetColor(SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := m_FileTheme.GetColor(SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end
else
begin
BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end;
if m_VScrollBar <> nil then
m_VScrollBar.UIStyle := OutUIStyle;
if m_HScrollBar <> nil then
m_HScrollBar.UIStyle := OutUIStyle;
end;
procedure TsuiStringGrid.SetVScrollBar(const Value: TsuiScrollBar);
begin
if m_VScrollBar = Value then
Exit;
if m_VScrollBar <> nil then
begin
m_VScrollBar.OnChange := nil;
m_VScrollBar.LineButton := 0;
m_VScrollBar.Max := 100;
m_VScrollBar.Enabled := true;
end;
m_VScrollBar := Value;
if m_VScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_VScrollBar.Orientation := suiVertical;
m_VScrollBar.OnChange := OnVScrollBArChange;
m_VScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.UpdateInnerScrollBars;
begin
if (m_VScrollBar <> nil) and (m_HScrollBar <> nil) then
ScrollBars := ssBoth
else if (m_VScrollBar <> nil) and (m_HScrollBar = nil) then
ScrollBars := ssVertical
else if (m_HScrollBar <> nil) and (m_VScrollBar = nil) then
ScrollBars := ssHorizontal
else
ScrollBars := ssNone;
end;
procedure TsuiStringGrid.UpdateScrollBars;
var
info : tagScrollInfo;
barinfo : tagScrollBarInfo;
begin
if m_UserChanging then
Exit;
m_SelfChanging := true;
if m_HScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), barinfo) then
begin
m_HScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_HScrollBar.LineButton := 0;
m_HScrollBar.Enabled := false;
m_HScrollBar.SliderVisible := false;
end
else
begin
m_HScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_HScrollBar.SmallChange := 3 * m_HScrollBar.PageSize;
m_HScrollBar.Enabled := true;
m_HScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_HORZ, info);
m_HScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_HScrollBar.Min := info.nMin;
m_HScrollBar.Position := info.nPos
end;
if m_VScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), barinfo) then
begin
m_VScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_VScrollBar.LineButton := 0;
m_VScrollBar.Enabled := false;
m_VScrollBar.SliderVisible := false;
end
else
begin
m_VScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_VScrollBar.Enabled := true;
m_VScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_VERT, info);
m_VScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_VScrollBar.Min := info.nMin;
m_VScrollBar.Position := info.nPos;
end;
m_SelfChanging := false;
end;
procedure TsuiStringGrid.UpdateScrollBarsPos;
var
L2R : Boolean;
begin
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
if m_HScrollBar <> nil then
begin
if Height < m_HScrollBar.Height then
m_HScrollBar.Visible := false
else
m_HScrollBar.Visible := true;
if L2R then
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
else
m_HScrollBar.Width := Width - 1
end
else
begin
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
begin
m_HScrollBar.Left := Left + m_VScrollBar.Width + 1;
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
end
else
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Width := Width - 1;
end;
end;
end;
if m_VScrollBar <> nil then
begin
if Width < m_VScrollBar.Width then
m_VScrollBar.Visible := false
else
m_VScrollBar.Visible := true;
if L2R then
begin
m_VScrollBar.Left := Left + Width - m_VScrollBar.Width - 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end
else
begin
m_VScrollBar.Left := Left + 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end;
end;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMClear(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMCut(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMEARSEBKGND(var Msg: TMessage);
begin
Paint();
end;
procedure TsuiStringGrid.WMHSCROLL(var Message: TWMHScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMLBUTTONDOWN(var Message: TMessage);
begin
inherited;
m_MouseDown := true;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMLButtonUp(var Message: TMessage);
begin
inherited;
m_MouseDown := false;
end;
procedure TsuiStringGrid.WMMOUSEMOVE(var Message: TMessage);
begin
inherited;
if m_MouseDown then UpdateScrollBars();
end;
procedure TsuiStringGrid.WMMOUSEWHEEL(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMMOVE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.WMPaste(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMSetText(var Message: TWMSetText);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMSIZE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.WMUndo(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMVSCROLL(var Message: TWMVScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
{ TImpColumnTitle }
procedure TImpColumnTitle.Assign(Source: TPersistent);
begin
if Source is TImpColumnTitle then
begin
if cvTitleAlignment in TImpColumnTitle(Source).FColumn.FAssignedValues then
Alignment := TImpColumnTitle(Source).Alignment;
if cvTitleColor in TImpColumnTitle(Source).FColumn.FAssignedValues then
Color := TImpColumnTitle(Source).Color;
if cvTitleCaption in TImpColumnTitle(Source).FColumn.FAssignedValues then
Caption := TImpColumnTitle(Source).Caption;
if cvTitleFont in TImpColumnTitle(Source).FColumn.FAssignedValues then
Font := TImpColumnTitle(Source).Font;
end
else
inherited Assign(Source);
end;
constructor TImpColumnTitle.Create(Column: TImpColumn);
begin
inherited Create;
FColumn := Column;
FFont := TFont.Create;
FFont.Assign(DefaultFont);
FFont.OnChange := FontChanged;
end;
function TImpColumnTitle.DefaultAlignment: TAlignment;
begin
Result := taLeftJustify;
end;
function TImpColumnTitle.DefaultCaption: string;
//var
{ Field: TField;}
begin
{ Field := FColumn.Field;
if Assigned(Field) then
Result := Field.DisplayName
else }
{ Result := FColumn.FieldName;}
end;
function TImpColumnTitle.DefaultColor: TColor;
var
Grid: TsuiStringGrid;
begin
Grid := FColumn.GetGrid;
if Assigned(Grid) then
Result := Grid.FixedColor
else
Result := clBtnFace;
end;
function TImpColumnTitle.DefaultDouble: double;
begin
Result := 0;
end;
function TImpColumnTitle.DefaultFont: TFont;
var
Grid: TsuiStringGrid;
begin
Grid := FColumn.GetGrid;
{if Assigned(Grid) then
Result := Grid.TitleFont
else }
Result := FColumn.Font;
end;
destructor TImpColumnTitle.Destroy;
begin
FFont.Free;
inherited Destroy;
end;
procedure TImpColumnTitle.FontChanged(Sender: TObject);
begin
Include(FColumn.FAssignedValues, cvTitleFont);
FColumn.Changed(True);
end;
function TImpColumnTitle.GetAlignment: TAlignment;
begin
if cvTitleAlignment in FColumn.FAssignedValues then
Result := FAlignment
else
Result := DefaultAlignment;
end;
function TImpColumnTitle.GetCaption: string;
begin
if cvTitleCaption in FColumn.FAssignedValues then
Result := FCaption
else
Result := DefaultCaption;
end;
function TImpColumnTitle.GetColor: TColor;
begin
if cvTitleColor in FColumn.FAssignedValues then
Result := FColor
else
Result := DefaultColor;
end;
function TImpColumnTitle.GetFont: TFont;
var
Save: TNotifyEvent;
Def: TFont;
begin
if not (cvTitleFont in FColumn.FAssignedValues) then
begin
Def := DefaultFont;
if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
begin
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
end;
end;
Result := FFont;
end;
function TImpColumnTitle.IsAlignmentStored: Boolean;
begin
Result := (cvTitleAlignment in FColumn.FAssignedValues) and
(FAlignment <> DefaultAlignment);
end;
function TImpColumnTitle.IsCaptionStored: Boolean;
begin
Result := (cvTitleCaption in FColumn.FAssignedValues) and
(FCaption <> DefaultCaption);
end;
function TImpColumnTitle.IsColorStored: Boolean;
begin
Result := (cvTitleColor in FColumn.FAssignedValues) and
(FColor <> DefaultColor);
end;
function TImpColumnTitle.IsFontStored: Boolean;
begin
Result := (cvTitleFont in FColumn.FAssignedValues);
end;
procedure TImpColumnTitle.RefreshDefaultFont;
var
Save: TNotifyEvent;
begin
if (cvTitleFont in FColumn.FAssignedValues) then Exit;
Save := FFont.OnChange;
FFont.OnChange := nil;
try
FFont.Assign(DefaultFont);
finally
FFont.OnChange := Save;
end;
end;
procedure TImpColumnTitle.RestoreDefaults;
var
FontAssigned: Boolean;
begin
FontAssigned := cvTitleFont in FColumn.FAssignedValues;
FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
FCaption := ＇＇＇＇;
RefreshDefaultFont;
{ If font was assigned, changing it back to default may affect grid title
height, and title height changes require layout and redraw of the grid. }
FColumn.Changed(FontAssigned);
end;
procedure TImpColumnTitle.SetAlignment(Value: TAlignment);
begin
if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
FAlignment := Value;
Include(FColumn.FAssignedValues, cvTitleAlignment);
FColumn.Changed(False);
end;
procedure TImpColumnTitle.SetCaption(const Value: string);
begin
if (cvTitleCaption in FColumn.FAssignedValues) and (Value = FCaption) then Exit;
FCaption := Value;
Include(FColumn.FAssignedValues, cvTitleCaption);
FColumn.Changed(False);
end;
procedure TImpColumnTitle.SetColor(Value: TColor);
begin
if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
FColor := Value;
Include(FColumn.FAssignedValues, cvTitleColor);
FColumn.Changed(False);
end;
procedure TImpColumnTitle.SetFont(Value: TFont);
begin
FFont.Assign(Value);
end;
{ TImpColumn }
procedure TImpColumn.Assign(Source: TPersistent);
begin
if Source is TImpColumn then
begin
if Assigned(Collection) then Collection.BeginUpdate;
try
RestoreDefaults;
//FieldName := TImpColumn(Source).FieldName;
if cvColor in TImpColumn(Source).AssignedValues then
Color := TImpColumn(Source).Color;
if cvWidth in TImpColumn(Source).AssignedValues then
Width := TImpColumn(Source).Width;
if cvFont in TImpColumn(Source).AssignedValues then
Font := TImpColumn(Source).Font;
if cvImeMode in TImpColumn(Source).AssignedValues then
ImeMode := TImpColumn(Source).ImeMode;
if cvImeName in TImpColumn(Source).AssignedValues then
ImeName := TImpColumn(Source).ImeName;
if cvAlignment in TImpColumn(Source).AssignedValues then
Alignment := TImpColumn(Source).Alignment;
if cvReadOnly in TImpColumn(Source).AssignedValues then
ReadOnly := TImpColumn(Source).ReadOnly;
Title := TImpColumn(Source).Title;
DropDownRows := TImpColumn(Source).DropDownRows;
ButtonStyle := TImpColumn(Source).ButtonStyle;
PickList := TImpColumn(Source).PickList;
//PopupMenu := TImpColumn(Source).PopupMenu;
finally
if Assigned(Collection) then Collection.EndUpdate;
end;
end
else
inherited Assign(Source);
end;
constructor TImpColumn.Create(Collection: TCollection);
var
Grid: TsuiStringGrid;
begin
Grid := nil;
if Assigned(Collection) and (Collection is TImpGridColumns) then
Grid := TImpGridColumns(Collection).Grid;
{if Assigned(Grid) then
Grid.BeginLayout; }
try
inherited Create(Collection);
FDropDownRows := 7;
FButtonStyle := cbsNone;
FFont := TFont.Create;
FFont.Assign(DefaultFont);
FFont.OnChange := FontChanged;
FImeMode := imDontCare;
FImeName := Screen.DefaultIme;
FTitle := CreateTitle;
//FPicklist := Tstrings.create;
finally
if Assigned(Grid) then
// Grid.EndLayout;
end;
end;
function TImpColumn.CreateTitle: TImpColumnTitle;
begin
Result := TImpColumnTitle.Create(Self);
end;
function TImpColumn.DefaultAlignment: TAlignment;
begin
Result := taLeftJustify;
end;
function TImpColumn.DefaultColor: TColor;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.Color
else
Result := clWindow;
end;
function TImpColumn.DefaultFont: TFont;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.Font
else
Result := FFont;
end;
function TImpColumn.DefaultImeMode: TImeMode;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.ImeMode
else
Result := FImeMode;
end;
function TImpColumn.DefaultImeName: TImeName;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.ImeName
else
Result := FImeName;
end;
function TImpColumn.DefaultReadOnly: Boolean;
begin
Result := false;
end;
function TImpColumn.DefaultWidth: Integer;
begin
if GetGrid = nil then
begin
Result := 64;
Exit;
end;
with GetGrid do
begin
Result := DefaultColWidth;
end;
end;
destructor TImpColumn.Destroy;
begin
FTitle.Free;
FFont.Free;
FPickList.Free;
inherited Destroy;
end;
procedure TImpColumn.FontChanged(Sender: TObject);
begin
Include(FAssignedValues, cvFont);
Title.RefreshDefaultFont;
Changed(False);
end;
function TImpColumn.GetAlignment: TAlignment;
begin
if cvAlignment in FAssignedValues then
Result := FAlignment
else
Result := DefaultAlignment;
end;
function TImpColumn.GetColor: TColor;
begin
if cvColor in FAssignedValues then
Result := FColor
else
Result := DefaultColor;
end;
function TImpColumn.GetDisplayName: string;
begin
Result := inherited GetDisplayName;
end;
function TImpColumn.GetFont: TFont;
var
Save: TNotifyEvent;
begin
if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
begin
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
end;
Result := FFont;
end;
function TImpColumn.GetGrid: TsuiStringGrid;
begin
if Assigned(Collection) and (Collection is TImpGridColumns) then
Result := TImpGridColumns(Collection).Grid
else
Result := nil;
end;
function TImpColumn.GetImeMode: TImeMode;
begin
if cvImeMode in FAssignedValues then
Result := FImeMode
else
Result := DefaultImeMode;
end;
function TImpColumn.GetImeName: TImeName;
begin
if cvImeName in FAssignedValues then
Result := FImeName
else
Result := DefaultImeName;
end;
function TImpColumn.GetPickList: TStrings;
begin
if FPickList = nil then
FPickList := TStringList.Create;
Result := FPickList;
end;
function TImpColumn.GetReadOnly: Boolean;
begin
if cvReadOnly in FAssignedValues then
Result := FReadOnly
else
Result := DefaultReadOnly;
end;
function TImpColumn.GetWidth: Integer;
begin
if cvWidth in FAssignedValues then
Result := FWidth
else
Result := DefaultWidth;
end;
function TImpColumn.IsAlignmentStored: Boolean;
begin
Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
end;
function TImpColumn.IsColorStored: Boolean;
begin
Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
end;
function TImpColumn.IsFontStored: Boolean;
begin
Result := (cvFont in FAssignedValues);
end;
function TImpColumn.IsImeModeStored: Boolean;
begin
Result := (cvImeMode in FAssignedValues) and (FImeMode <> DefaultImeMode);
end;
function TImpColumn.IsImeNameStored: Boolean;
begin
Result := (cvImeName in FAssignedValues) and (FImeName <> DefaultImeName);
end;
function TImpColumn.IsReadOnlyStored: Boolean;
begin
Result := (cvReadOnly in FAssignedValues) and (FReadOnly <> DefaultReadOnly);
end;
function TImpColumn.IsWidthStored: Boolean;
begin
Result := (cvWidth in FAssignedValues) and (FWidth <> DefaultWidth);
end;
procedure TImpColumn.RefreshDefaultFont;
var
Save: TNotifyEvent;
begin
if cvFont in FAssignedValues then Exit;
Save := FFont.OnChange;
FFont.OnChange := nil;
try
FFont.Assign(DefaultFont);
finally
FFont.OnChange := Save;
end;
end;
procedure TImpColumn.RestoreDefaults;
var
FontAssigned: Boolean;
begin
FontAssigned := cvFont in FAssignedValues;
FTitle.RestoreDefaults;
FAssignedValues := [];
RefreshDefaultFont;
FPickList.Free;
FPickList := nil;
ButtonStyle := cbsNone;
Changed(FontAssigned);
end;
procedure TImpColumn.SetAlignment(Value: TAlignment);
begin
if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
FAlignment := Value;
Include(FAssignedValues, cvAlignment);
Changed(False);
end;
procedure TImpColumn.SetButtonStyle(Value: TImpColumnButtonStyle);
begin
if Value = FButtonStyle then Exit;
FButtonStyle := Value;
Changed(False);
end;
procedure TImpColumn.SetColor(Value: TColor);
begin
if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
FColor := Value;
Include(FAssignedValues, cvColor);
Changed(False);
end;
procedure TImpColumn.SetEditStyle(Value: TImpColumnEditStyle);
begin
if Value = FEditStyle then Exit;
FEditStyle := Value;
Changed(False);
end;
procedure TImpColumn.SetFont(Value: TFont);
begin
FFont.Assign(Value);
Include(FAssignedValues, cvFont);
Changed(False);
end;
procedure TImpColumn.SetImeMode(Value: TImeMode);
begin
if (cvImeMode in FAssignedValues) or (Value <> DefaultImeMode) then
begin
FImeMode := Value;
Include(FAssignedValues, cvImeMode);
end;
Changed(False);
end;
procedure TImpColumn.SetImeName(Value: TImeName);
begin
if (cvImeName in FAssignedValues) or (Value <> DefaultImeName) then
begin
FImeName := Value;
Include(FAssignedValues, cvImeName);
end;
Changed(False);
end;
procedure TImpColumn.SetPickList(Value: TStrings);
begin
if Value = nil then
begin
FPickList.Free;
FPickList := nil;
Exit;
end;
PickList.Assign(Value);
end;
procedure TImpColumn.SetReadOnly(Value: Boolean);
begin
if (cvReadOnly in FAssignedValues) and (Value = FReadOnly) then Exit;
FReadOnly := Value;
Include(FAssignedValues, cvReadOnly);
Changed(False);
end;
procedure TImpColumn.SetTitle(Value: TImpColumnTitle);
begin
FTitle.Assign(Value);
end;
procedure TImpColumn.SetWidth(Value: Integer);
begin
if (cvWidth in FAssignedValues) or (Value <> DefaultWidth) then
begin
FWidth := Value;
Include(FAssignedValues, cvWidth);
end;
Changed(False);
end;
{ TImpGridColumns }
function TImpGridColumns.Add: TImpColumn;
begin
Result := TImpColumn(inherited Add);
end;
constructor TImpGridColumns.Create(Grid: TsuiStringGrid;
ColumnClass: TImpColumnClass);
begin
inherited Create(ColumnClass);
FGrid := Grid;
end;
function TImpGridColumns.GetCount: Integer;
begin
Result := inherited Count;
end;
function TImpGridColumns.GeTImpColumn(Index: Integer): TImpColumn;
begin
Result := TImpColumn(inherited Items[Index]);
end;
function TImpGridColumns.GetOwner: TPersistent;
begin
Result := FGrid;
end;
function TImpGridColumns.GetState: TImpGridColumnsState;
begin
Result := TImpGridColumnsState((Count > 0)) ;
end;
procedure TImpGridColumns.LoadFromFile(const Filename: string);
var
S: TFileStream;
begin
S := TFileStream.Create(Filename, fmOpenRead);
try
LoadFromStream(S);
finally
S.Free;
end;
end;
type
TImpColumnsWrapper = class(TComponent)
private
FColumns: TImpGridColumns;
published
property Columns: TImpGridColumns read FColumns write FColumns;
end;
procedure TImpGridColumns.LoadFromStream(S: TStream);
var
Wrapper: TImpColumnsWrapper;
begin
end;
procedure TImpGridColumns.RebuildColumns;
var
I: Integer;
begin
end;
procedure TImpGridColumns.RestoreDefaults;
var
I: Integer;
begin
BeginUpdate;
try
for I := 0 to Count-1 do
Items[I].RestoreDefaults;
finally
EndUpdate;
end;
end;
procedure TImpGridColumns.SaveToFile(const Filename: string);
var
S: TStream;
begin
S := TFileStream.Create(Filename, fmCreate);
try
SaveToStream(S);
finally
S.Free;
end;
end;
procedure TImpGridColumns.SaveToStream(S: TStream);
var
Wrapper: TImpColumnsWrapper;
begin
Wrapper := TImpColumnsWrapper.Create(nil);
try
Wrapper.Columns := Self;
S.WriteComponent(Wrapper);
finally
Wrapper.Free;
end;
end;
procedure TImpGridColumns.SeTImpColumn(Index: Integer; Value: TImpColumn);
begin
Items[Index].Assign(Value);
end;
procedure TImpGridColumns.SetState(NewState: TImpGridColumnsState);
begin
if NewState = State then Exit;
if NewState = csDefault then
Clear
else
RebuildColumns;
end;
procedure TImpGridColumns.Update(Item: TCollectionItem);
var
Raw: Integer;
begin
end;
{ TImpGridInplaceEdit }
procedure TImpGridInplaceEdit.BoundsChanged;
var
R: TRect;
begin
SetRect(R, 2, 2, Width - 2, Height);
if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
if SysLocale.Fareast then
SetImeCompositionWindow(Font, R.Left, R.Top);
end;
procedure TImpGridInplaceEdit.CloseUp(Accept: Boolean);
var
//MasterField: TField;
ListValue: Variant;
begin
if FListVisible then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
{ if FActiveList = FDataList then
ListValue := FDataList.KeyValue
else }
if FPickList.ItemIndex <> -1 then
ListValue := FPickList.Items[FPicklist.ItemIndex];
SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
Invalidate;
if Accept then
if (not VarIsNull(ListValue)) and EditCanModify then
{with TsuiStringGrid(Grid) do}
Text := ListValue;
end;
end;
procedure TImpGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
CloseUp(False);
end;
constructor TImpGridInplaceEdit.Create(Owner: TComponent);
begin
inherited Create(Owner);
//FLookupSource := TDataSource.Create(Self);
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
FEditStyle := esEllipsis;
end;
procedure TImpGridInplaceEdit.DoDropDownKeys(var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_UP, VK_DOWN:
if ssAlt in Shift then
begin
if FListVisible then CloseUp(True) else DropDown;
Key := 0;
end;
VK_RETURN, VK_ESCAPE:
if FListVisible and not (ssAlt in Shift) then
begin
CloseUp(Key = VK_RETURN);
Key := 0;
end;
end;
end;
procedure TImpGridInplaceEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
Column: TImpColumn;
str : Tstrings;
begin
if not FListVisible and Assigned(FActiveList) then
begin
FActiveList.Width := Width;
with TsuiStringGrid(Grid) do
Column := Columns[col];
begin
FPickList.Color := Color;
FPickList.Font := Font;
FPickList.Items := Column.Picklist;
if assigned(TsuiStringGrid(Grid).OnPickListDropDown) then begin
str := Tstringlist.create;
str.assign(fpicklist.items);
TsuiStringGrid(Grid).OnPickListDropDown(Self,TsuiStringgrid(Grid).col,TsuiStringgrid(Grid).row,
str);
fpicklist.items.Assign(str);
end;
if FPickList.Items.Count >= Column.DropDownRows then
FPickList.Height := Column.DropDownRows * FPickList.ItemHeight + 4
else
FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
// if Column.Field.IsNull then
FPickList.ItemIndex := -1;
// else
// FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Value);
J := FPickList.ClientWidth;
for I := 0 to FPickList.Items.Count - 1 do
begin
Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
if Y > J then J := Y+10;
end;
FPickList.ClientWidth := J;
end;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FListVisible := True;
Invalidate;
Windows.SetFocus(Handle);
end;
end;
type
TWinControlCracker = class(TWinControl) end;
procedure TImpGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
begin
TsuiStringGrid(Grid).EditButtonClick;
KillMessage(Handle, WM_CHAR);
end
else
inherited KeyDown(Key, Shift);
end;
procedure TImpGridInplaceEdit.ListMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;
procedure TImpGridInplaceEdit.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (FEditStyle <> esSimple) and
PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
begin
if FListVisible then
CloseUp(False)
else
begin
MouseCapture := True;
FTracking := True;
TrackButton(X, Y);
if Assigned(FActiveList) then DropDown;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TImpGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
if FTracking then
begin
TrackButton(X, Y);
if FListVisible then
begin
ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
if PtInRect(FActiveList.ClientRect, ListPos) then
begin
StopTracking;
MousePos := PointToSmallPoint(ListPos);
SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
Exit;
end;
end;
end;
inherited MouseMove(Shift, X, Y);
end;
procedure TImpGridInplaceEdit.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
WasPressed: Boolean;
begin
WasPressed := FPressed;
StopTracking;
if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
TsuiStringGrid(Grid).EditButtonClick;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TImpGridInplaceEdit.PaintWindow(DC: HDC);
var
R: TRect;
Flags: Integer;
W: Integer;
begin
if FEditStyle <> esSimple then
begin
SetRect(R, Width - FButtonWidth, 0, Width, Height);
Flags := 0;
if FEditStyle in [esDataList, esPickList] then
begin
if FActiveList = nil then
Flags := DFCS_INACTIVE
else if FPressed then
Flags := DFCS_FLAT or DFCS_PUSHED;
DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
end
else { esEllipsis }
begin
if FPressed then
Flags := BF_FLAT;
DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags or BF_FLAT);
Flags := ((R.Right - R.Left) shr 1) + Ord(FPressed);
W := Height shr 3;
if W = 0 then W := 1;
PatBlt(DC, R.Left + Flags, R.Top + 10, 1, 1, BLACKNESS);
PatBlt(DC, R.Left + Flags-3, R.Top + 10, 1, 1, BLACKNESS);
PatBlt(DC, R.Left + Flags+3, R.Top + 10, 1, 1, BLACKNESS);
end;
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
inherited PaintWindow(DC);
end;
procedure TImpGridInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
// if Value = FEditStyle then Exit;
FEditStyle := Value;
case Value of
esPickList:
begin
if FPickList = nil then
begin
FPickList := TPopupListbox.Create(Self);
FPickList.Visible := False;
FPickList.Parent := Self;
FPickList.OnMouseUp := ListMouseUp;
FPickList.IntegralHeight := True;
FPickList.ItemHeight := 11;
end;
FActiveList := FPickList;
end;
{ esDataList:
begin
if FDataList = nil then
begin
FDataList := TPopupDataList.Create(Self);
FDataList.Visible := False;
FDataList.Parent := Self;
FDataList.OnMouseUp := ListMouseUp;
end;
FActiveList := FDataList;
end;}
else { cbsNone, cbsEllipsis, or read only field }
FActiveList := nil;
end;
with TsuiStringGrid(Grid) do
Self.ReadOnly := Columns[col].ReadOnly;
Repaint;
end;
procedure TImpGridInplaceEdit.StopTracking;
begin
if FTracking then
begin
TrackButton(-1, -1);
FTracking := False;
MouseCapture := False;
end;
end;
procedure TImpGridInplaceEdit.TrackButton(X, Y: Integer);
var
NewState: Boolean;
R: TRect;
begin
SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
NewState := PtInRect(R, Point(X, Y));
if FPressed <> NewState then
begin
FPressed := NewState;
InvalidateRect(Handle, @R, False);
end;
end;
procedure TImpGridInplaceEdit.UpdateContents;
var
Column: TImpColumn;
NewStyle: TEditStyle;
{MasterField: TField; }
begin
with TsuiStringgrid(Grid) do
Column := Columns[col];
NewStyle := esSimple;
case Column.ButtonStyle of
cbsEllipsis: NewStyle := esEllipsis;
cbsPicklist: begin
NewStyle := esPickList;
{ if Assigned(Column.Field) then
with Column.Field do
begin
{ Show the dropdown button only if the field is editable }
{ if FieldKind = fkLookup then
begin
MasterField := Dataset.FieldByName(KeyFields);
{ Column.DefaultReadonly will always be True for a lookup field.
Test if Column.ReadOnly has been assigned a value of True }
{ if Assigned(MasterField) and MasterField.CanModify and
not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
with TCustomDBGrid(Grid) do
if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
NewStyle := esDataList
end
else
if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
not Column.Readonly then
NewStyle := esPickList;
end;}
end;
end;
EditStyle := NewStyle;
inherited UpdateContents;
end;
procedure TImpGridInplaceEdit.WMCancelMode(var Message: TMessage);
begin
StopTracking;
inherited;
end;
procedure TImpGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
if SysLocale.FarEast then
begin
ImeName := Screen.DefaultIme;
ImeMode := imDontCare;
end;
inherited;
CloseUp(False);
end;
procedure TImpGridInplaceEdit.WMLButtonDblClk(
var Message: TWMLButtonDblClk);
begin
with Message do
if (FEditStyle <> esSimple) and
PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
Exit;
inherited;
end;
procedure TImpGridInplaceEdit.WMPaint(var Message: TWMPaint);
begin
PaintHandler(Message);
end;
procedure TImpGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
P: TPoint;
begin
GetCursorPos(P);
if (FEditStyle <> esSimple) and
PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), ScreenToClient(P)) then
Windows.SetCursor(LoadCursor(0, idc_Arrow))
else
inherited;
end;
procedure TImpGridInplaceEdit.WndProc(var Message: TMessage);
begin
case Message.Msg of
wm_KeyDown, wm_SysKeyDown, wm_Char:
if EditStyle in [esPickList, esDataList] then
with TWMKey(Message) do
begin
//DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
if (CharCode <> 0) and FListVisible then
begin
with TMessage(Message) do
SendMessage(FActiveList.Handle, Msg, WParam, LParam);
Exit;
end;
end
end;
inherited;
end;
{ TPopupListbox }
procedure TPopupListbox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TPopupListbox.CreateWnd;
begin
inherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;
procedure TPopupListbox.KeyPress(var Key: Char);
var
TickCount: Integer;
begin
case Key of
#8, #27: FSearchText := ＇＇＇＇;
#32..#255:
begin
TickCount := GetTickCount;
if TickCount - FSearchTickCount > 2000 then FSearchText := ＇＇＇＇;
FSearchTickCount := TickCount;
if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
Key := #0;
end;
end;
inherited Keypress(Key);
end;
procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
TImpGridInplaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;
end.
当行高或列宽变化时,listView的宽高会随着改变吗 ？
2楼: 我也在找方法呢，不过感觉非常困难，不知道哪位高手知道怎么做？[8D] 如好用的财务软件
3楼: 我也想知道
4楼: 你是不是希望能够在点击单元格时出现ListBox啊？你可以在单元格上放置一个ListBox组件,利用StringGrid的点击单元格事件来显示出ListBox组件,然后将选种的内容赋值给单元格
5楼: 路过学习 帮你顶
6楼: 同意warmhouse,我就是这样做的。
财务软件版7楼: warmhouse的做法是很不错的，以前我遇到同样的问题也是这样解决的 。。。。。。
8楼: listview 这样做就比较麻烦了
9楼: procedure TFouStyleParamsFrm.grdClick(Sender: TObject);
var
grd:TStringGrid;
Rect: TRect;
begin
grd:=(Sender as TStringGrid);
Rect:=grd.CellRect(grd.Col,grd.Row);
//设置下拉控件
if grd.Col=1 then
begin
lcbAtt.Parent:=grd;
lcbAtt.Left:=Rect.Left;
lcbAtt.Top:=Rect.Top;
lcbAtt.Width:=Rect.Right-Rect.Left;
lcbAtt.Height:=Rect.Bottom-Rect.Top;
lcbAtt.Font:=grd.Font;
lcbAtt.Text:=grd.Cells[grd.Col,grd.Row];
lcbAtt.Visible:=true; //放在赋值后面，以免触发OnChange事件
lcbAtt.SetFocus;
end
else
begin
lcbAtt.Visible:=False;
end;
end;
10楼: 借鉴别的类似控件,我自己封装了TstringGrid,可以实现tcombobox的选取,要加上
ListView需你参考解决.
还有就是我是在TSuistringgrid基础上集成的
////////////////////////////////////////////////////////////////////////////////
//
//
// FileName : SUIGrid.pas
// Creator : Shen Min
// Date : 2003-04-03 V1-V3
// 3003-07-04 V4
// Comment :
//
// Copyright (c) 2002-2003 Sunisoft
// http://www.sunisoft.com
// Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////
unit SUIGrid;
interface
{$I SUIPack.inc}
uses Windows, Messages, SysUtils,Variants, Classes, Controls, Grids, Graphics, Forms,
SUIThemes, SUIScrollBar, SUIMgr, StdCtrls;
type
TSelection = record
StartPos, EndPos: Integer;
end;
type
TImpgridCellEvent = procedure (Sender: TObject; Col, Row: Longint) of object;
TImpgriddropdownEvent = procedure (Sender: TObject; Col, Row: Longint;
var Picklist:Tstrings) of object;
TImpColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
cvTitleCaption, cvTitleAlignment, cvTitleFont, cvImeMode, cvImeName);
TImpColumnValues = set of TImpColumnValue;
TImpGridColumnsState = (csDefault, csCustomized);
TImpColumn = class;
TsuiStringgrid = class;
TImpColumnClass = class of TImpColumn;
TImpColumnTitle = class(TPersistent)
private
FColumn: TImpColumn;
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: TImpColumn);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function DefaultAlignment: TAlignment;
function DefaultColor: TColor;
function DefaultFont: TFont;
function DefaultCaption: string;
function DefaultDouble: double;
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;
TImpColumnButtonStyle = (cbsPicklist, cbsEllipsis, cbsNone);
TImpColumnEditStyle=(cvString,cvInteger,cvDouble);
TImpColumn = class(TCollectionItem)
private
FColor: TColor;
FWidth: Integer;
FTitle: TImpColumnTitle;
FFont: TFont;
FImeMode: TImeMode;
FImeName: TImeName;
FPickList: TStrings;
// FPopupMenu: TPopupMenu;
FDropDownRows: Cardinal;
FButtonStyle: TImpColumnButtonStyle;
FAlignment: TAlignment;
FReadonly: Boolean;
FAssignedValues: TImpColumnValues;
FEditStyle:TImpColumnEditStyle;
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: TImpColumnButtonStyle);
procedure SetEditStyle(Value: TImpColumnEditStyle);
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: TImpColumnTitle);
procedure SetWidth(Value: Integer); virtual;
protected
function CreateTitle: TImpColumnTitle; virtual;
function GetGrid: TsuiStringGrid;
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: TsuiStringGrid read GetGrid;
property AssignedValues: TImpColumnValues read FAssignedValues;
// property Field: TField read GetField write SetField;
published
property Alignment: TAlignment read GetAlignment write SetAlignment
stored IsAlignmentStored;
property ButtonStyle: TImpColumnButtonStyle read FButtonStyle write SetButtonStyle
default cbsNone;
property EditStyle: TImpColumnEditStyle read FEditStyle write SetEditStyle
default cvString;
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;
property Font: TFont read GetFont write SetFont stored IsFontStored;
property ImeMode: TImeMode read GetImeMode write SetImeMode stored IsImeModeStored;
property ImeName: TImeName read GetImeName write SetImeName stored IsImeNameStored;
property PickList: TStrings read GetPickList write SetPickList;
// property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly
stored IsReadOnlyStored;
property Title: TImpColumnTitle read FTitle write SetTitle;
property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
end;
TImpGridColumns = class(TCollection)
private
FGrid: TsuiStringGrid;
function GetCount:Integer;
function GetState: TImpGridColumnsState;
function GeTImpColumn(Index: Integer): TImpColumn;
procedure SeTImpColumn(Index: Integer; Value: TImpColumn);
procedure SetState(NewState: TImpGridColumnsState);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
constructor Create(Grid: TsuiStringGrid; ColumnClass: TImpColumnClass);
function Add: TImpColumn;
procedure LoadFromFile(const Filename: string);
procedure LoadFromStream(S: TStream);
procedure RestoreDefaults;
procedure RebuildColumns;
procedure SaveToFile(const Filename: string);
procedure SaveToStream(S: TStream);
property State: TImpGridColumnsState read GetState write SetState;
property Grid: TsuiStringGrid read FGrid;
property Items[Index: Integer]: TImpColumn read GeTImpColumn write SeTImpColumn; default;
property Count: integer read GetCount;
end;
{$IFDEF SUIPACK_D5}
TsuiCustomDrawGrid = class(TDrawGrid)
{$ENDIF}
{$IFDEF SUIPACK_D6UP}
TsuiCustomDrawGrid = class(TCustomDrawGrid)
{$ENDIF}
private
m_BorderColor : TColor;
m_FocusedColor : TColor;
m_SelectedColor : TColor;
m_UIStyle : TsuiUIStyle;
m_FileTheme : TsuiFileTheme;
m_FixedFontColor: TColor;
m_MouseDown : Boolean;
// scroll bar
m_VScrollBar : TsuiScrollBar;
m_HScrollBar : TsuiScrollBar;
m_SelfChanging : Boolean;
m_UserChanging : Boolean;
procedure SetHScrollBar(const Value: TsuiScrollBar);
procedure SetVScrollBar(const Value: TsuiScrollBar);
procedure OnHScrollBarChange(Sender : TObject);
procedure OnVScrollBarChange(Sender : TObject);
procedure UpdateScrollBars();
procedure UpdateScrollBarsPos();
procedure UpdateInnerScrollBars();
procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
procedure SetBorderColor(const Value: TColor);
procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
procedure SetUIStyle(const Value: TsuiUIStyle);
procedure SetFocusedColor(const Value: TColor);
procedure SetSelectedColor(const Value: TColor);
procedure SetFixedFontColor(const Value: TColor);
function GetCtl3D: Boolean;
procedure SetFontColor(const Value: TColor);
function GetFontColor: TColor;
procedure SetFileTheme(const Value: TsuiFileTheme);
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Paint(); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create (AOwner: TComponent); override;
published
property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
property Color;
property FixedColor;
property BorderColor : TColor read m_BorderColor write SetBorderColor;
property FocusedColor : TColor read m_FocusedColor write SetFocusedColor;
property SelectedColor : TColor read m_SelectedColor write SetSelectedColor;
property FixedFontColor : TColor read m_FixedFontColor write SetFixedFontColor;
property FontColor : TColor read GetFontColor write SetFontColor;
property Ctl3D read GetCtl3D;
// scroll bar
property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;
end;
TsuiDrawGrid = class(TsuiCustomDrawGrid)
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property ColCount;
property Constraints;
property DefaultColWidth;
property DefaultRowHeight;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedCols;
property RowCount;
property FixedRows;
property Font;
property GridLineWidth;
property Options;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollBars;
property ShowHint;
property TabOrder;
property Visible;
property VisibleColCount;
property VisibleRowCount;
property OnClick;
property OnColumnMoved;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawCell;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetEditMask;
property OnGetEditText;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnRowMoved;
property OnSelectCell;
property OnSetEditText;
property OnStartDock;
property OnStartDrag;
property OnTopLeftChanged;
end;
TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
TPopupListbox = class;
TsuiStringGrid = class(TStringGrid)
private
m_BorderColor : TColor;
m_FocusedColor : TColor;
m_SelectedColor : TColor;
m_UIStyle : TsuiUIStyle;
m_FixedFontColor: TColor;
m_FileTheme : TsuiFileTheme;
m_MouseDown : Boolean;
// scroll bar
m_VScrollBar : TsuiScrollBar;
m_HScrollBar : TsuiScrollBar;
m_SelfChanging : Boolean;
m_UserChanging : Boolean;
fOntoomuch:TnotifyEvent;
fOnNewRow:TnotifyEvent;
fOnElippsisclicked:TImpgridCellEvent;
fOnPicklistDropdown:TImpgridDropDownEvent;
fToomuch:boolean;
function GetColCount: Integer;
procedure SetColCount(Col: LongInt);
procedure Editbuttonclick;
procedure SetHScrollBar(const Value: TsuiScrollBar);
procedure SetVScrollBar(const Value: TsuiScrollBar);
procedure OnHScrollBarChange(Sender : TObject);
procedure OnVScrollBarChange(Sender : TObject);
procedure UpdateScrollBars();
procedure UpdateScrollBarsPos();
procedure UpdateInnerScrollBars();
procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
procedure CMVisibleChanged(var Msg : TMEssage); message CM_VISIBLECHANGED;
procedure CMBIDIMODECHANGED(var Msg : TMessage); message CM_BIDIMODECHANGED;
procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
procedure SetBorderColor(const Value: TColor);
procedure SetFocusedColor(const Value: TColor);
procedure SetSelectedColor(const Value: TColor);
procedure SetUIStyle(const Value: TsuiUIStyle);
procedure SetFixedFontColor(const Value: TColor);
function GetCtl3D: Boolean;
procedure SetFontColor(const Value: TColor);
function GetFontColor: TColor;
procedure SetFileTheme(const Value: TsuiFileTheme);
function GetBGColor: TColor;
procedure SetBGColor(const Value: TColor);
function GetFixedBGColor: TColor;
procedure SetFixedBGColor(const Value: TColor);
procedure WMEARSEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
protected
function GetSelLength: Integer; virtual;
function GetSelStart: Integer; virtual;
procedure SetSelLength(Value: Integer); virtual;
procedure SetSelStart(Value: Integer); virtual;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Paint(); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
function CreateEditor: TInplaceEdit; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure KeyPress(var Key: Char); override;
public
Columns: TImpGridColumns;
constructor Create (AOwner: TComponent); override;
property SelLength: Integer read GetSelLength write SetSelLength;
property SelStart: Integer read GetSelStart write SetSelStart;
published
property OnTooMuchrows : TNotifyEvent read fOntoomuch write fOntoomuch;
property OnNewRow : TNotifyEvent read fOnNewRow write fOnNewRow;
property OnElippsisclicked : TImpGridCellEvent read fOnElippsisclicked write fOnElippsisclicked;
property OnPicklistDropdown : TImpGridDropdownEvent read fOnPicklistDropdown write fOnPicklistDropdown;
property ColCount: Longint read GetColCount write SetColCount default 5;
property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
property BGColor : TColor read GetBGColor write SetBGColor;
property BorderColor : TColor read m_BorderColor write SetBorderColor;
property FocusedColor : TColor read m_FocusedColor write SetFocusedColor;
property SelectedColor : TColor read m_SelectedColor write SetSelectedColor;
property FixedFontColor : TColor read m_FixedFontColor write SetFixedFontColor;
property FixedBGColor : TColor read GetFixedBGColor write SetFixedBGColor;
property FontColor : TColor read GetFontColor write SetFontColor;
property Ctl3D read GetCtl3D;
// scroll bar
property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;
end;
TImpGridInplaceEdit = class(TInplaceEdit)
private
FButtonWidth: Integer;
//FDataList: TDBLookupListBox;
FPickList: TPopupListbox;
FActiveList: TWinControl;
//FLookupSource: TDatasource;
FEditStyle: TEditStyle;
FListVisible: Boolean;
FTracking: Boolean;
FPressed: Boolean;
procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetEditStyle(Value: TEditStyle);
procedure StopTracking;
procedure TrackButton(X,Y: Integer);
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
procedure WMPaint(var Message: TWMPaint); message wm_Paint;
procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
protected
procedure BoundsChanged; override;
procedure CloseUp(Accept: Boolean);
procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
procedure DropDown;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure PaintWindow(DC: HDC); override;
procedure UpdateContents; override;
procedure WndProc(var Message: TMessage); override;
property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
property ActiveList: TWinControl read FActiveList write FActiveList;
//property DataList: TDBLookupListBox read FDataList;
property PickList: TPopupListbox read FPickList;
public
constructor Create(Owner: TComponent); override;
end;
{ TPopupListbox }
TPopupListbox = class(TCustomListbox)
private
FSearchText: String;
FSearchTickCount: Longint;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure KeyPress(var Key: Char); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
end;
const
ColumnTitleValues = [cvTitleColor..cvTitleFont];
cm_DeferLayout = WM_USER + 100;
implementation
uses SUIPublic, SUIProgressBar;
var
DrawBitmap: TBitmap;
UserCount: Integer;
procedure UsesBitmap;
begin
if UserCount = 0 then
DrawBitmap := TBitmap.Create;
Inc(UserCount);
end;
procedure ReleaseBitmap;
begin
Dec(UserCount);
if UserCount = 0 then DrawBitmap.Free;
end;
function Max(X, Y: Integer): Integer;
begin
Result := Y;
if X > Y then Result := X;
end;
procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
M: TMsg;
begin
M.Message := 0;
if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
PostQuitMessage(M.wparam);
end;
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment);
const
AlignFlags : array [TAlignment] of Integer =
( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
B, R: TRect;
I, Left: Integer;
begin
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin { Use ExtTextOut for solid colors }
case Alignment of
taLeftJustify:
Left := ARect.Left + DX;
taRightJustify:
Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
else { taCenter }
Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
end
else begin { Use FillRect and Drawtext for dithered colors }
DrawBitmap.Canvas.Lock;
try
with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
begin { brush origin tics in painting / scrolling. }
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
end;
ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
finally
DrawBitmap.Canvas.Unlock;
end;
end;
end;
{ TsuiCustomDrawGrid }
procedure TsuiCustomDrawGrid.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.CMVisibleChanged(var Msg: TMEssage);
begin
inherited;
if not Visible then
begin
if m_VScrollBar <> nil then
m_VScrollBar.Visible := Visible;
if m_HScrollBar <> nil then
m_HScrollBar.Visible := Visible;
end
else
UpdateScrollBarsPos();
end;
constructor TsuiCustomDrawGrid.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
BorderStyle := bsNone;
BorderWidth := 1;
UIStyle := GetSUIFormStyle(AOwner);
m_MouseDown := false;
FocusedColor := clGreen;
SelectedColor := clYellow;
ParentCtl3D := false;
inherited Ctl3D := false;
end;
procedure TsuiCustomDrawGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
R : TRect;
begin
if not DefaultDrawing then
begin
inherited;
exit;
end;
R := ARect;
try
if gdFixed in AState then
Exit;
if gdSelected in AState then
begin
Canvas.Brush.Color := m_SelectedColor;
end;
if gdFocused in AState then
begin
Canvas.Brush.Color := m_FocusedColor;
end;
if AState = [] then
Canvas.Brush.Color := Color;
Canvas.FillRect(R);
finally
inherited;
end;
end;
function TsuiCustomDrawGrid.GetCtl3D: Boolean;
begin
Result := false;
end;
function TsuiCustomDrawGrid.GetFontColor: TColor;
begin
Result := Font.Color;
end;
procedure TsuiCustomDrawGrid.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (
(Operation = opRemove) and
(AComponent = m_HScrollBar)
)then
begin
m_HScrollBar := nil;
UpdateInnerScrollBars();
end;
if (
(Operation = opRemove) and
(AComponent = m_VScrollBar)
)then
begin
m_VScrollBar := nil;
UpdateInnerScrollBars();
end;
if (
(Operation = opRemove) and
(AComponent = m_FileTheme)
)then
begin
m_FileTheme := nil;
SetUIStyle(SUI_THEME_DEFAULT);
end;
end;
procedure TsuiCustomDrawGrid.OnHScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, m_HScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiCustomDrawGrid.OnVScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, m_VScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiCustomDrawGrid.Paint;
begin
inherited;
DrawControlBorder(self, m_BorderColor, Color);
end;
procedure TsuiCustomDrawGrid.SetBorderColor(const Value: TColor);
begin
m_BorderColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetFileTheme(const Value: TsuiFileTheme);
begin
m_FileTheme := Value;
SetUIStyle(m_UIStyle);
end;
procedure TsuiCustomDrawGrid.SetFixedFontColor(const Value: TColor);
begin
m_FixedFontColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetFocusedColor(const Value: TColor);
begin
m_FocusedColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetFontColor(const Value: TColor);
begin
Font.Color := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetHScrollBar(const Value: TsuiScrollBar);
begin
if m_HScrollBar = Value then
Exit;
if m_HScrollBar <> nil then
begin
m_HScrollBar.OnChange := nil;
m_HScrollBar.LineButton := 0;
m_HScrollBar.Max := 100;
m_HScrollBar.Enabled := true;
end;
m_HScrollBar := Value;
if m_HScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_HScrollBar.Orientation := suiHorizontal;
m_HScrollBar.OnChange := OnHScrollBarChange;
m_HScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.SetSelectedColor(const Value: TColor);
begin
m_SelectedColor := Value;
Repaint();
end;
procedure TsuiCustomDrawGrid.SetUIStyle(const Value: TsuiUIStyle);
var
OutUIStyle : TsuiUIStyle;
begin
m_UIStyle := Value;
if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
begin
BorderColor := m_FileTheme.GetColor(SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := m_FileTheme.GetColor(SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := m_FileTheme.GetColor(SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end
else
begin
BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end;
if m_VScrollBar <> nil then
m_VScrollBar.UIStyle := OutUIStyle;
if m_HScrollBar <> nil then
m_HScrollBar.UIStyle := OutUIStyle;
end;
procedure TsuiCustomDrawGrid.SetVScrollBar(const Value: TsuiScrollBar);
begin
if m_VScrollBar = Value then
Exit;
if m_VScrollBar <> nil then
begin
m_VScrollBar.OnChange := nil;
m_VScrollBar.LineButton := 0;
m_VScrollBar.Max := 100;
m_VScrollBar.Enabled := true;
end;
m_VScrollBar := Value;
if m_VScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_VScrollBar.Orientation := suiVertical;
m_VScrollBar.OnChange := OnVScrollBArChange;
m_VScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.UpdateInnerScrollBars;
begin
if (m_VScrollBar <> nil) and (m_HScrollBar <> nil) then
ScrollBars := ssBoth
else if (m_VScrollBar <> nil) and (m_HScrollBar = nil) then
ScrollBars := ssVertical
else if (m_HScrollBar <> nil) and (m_VScrollBar = nil) then
ScrollBars := ssHorizontal
else
ScrollBars := ssNone;
end;
procedure TsuiCustomDrawGrid.UpdateScrollBars;
var
info : tagScrollInfo;
barinfo : tagScrollBarInfo;
L2R : Boolean;
begin
if m_UserChanging then
Exit;
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
m_SelfChanging := true;
if m_HScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), barinfo) then
begin
m_HScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_HScrollBar.LineButton := 0;
m_HScrollBar.Enabled := false;
m_HScrollBar.SliderVisible := false;
end
else
begin
m_HScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_HScrollBar.SmallChange := 3 * m_HScrollBar.PageSize;
m_HScrollBar.Enabled := true;
m_HScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_HORZ, info);
m_HScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_HScrollBar.Min := info.nMin;
if L2R then
m_HScrollBar.Position := info.nPos
else
m_HScrollBar.Position := m_HScrollBar.Max - info.nPos;
end;
if m_VScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), barinfo) then
begin
m_VScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_VScrollBar.LineButton := 0;
m_VScrollBar.Enabled := false;
m_VScrollBar.SliderVisible := false;
end
else
begin
m_VScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_VScrollBar.Enabled := true;
m_VScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_VERT, info);
m_VScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_VScrollBar.Min := info.nMin;
m_VScrollBar.Position := info.nPos;
end;
m_SelfChanging := false;
end;
procedure TsuiCustomDrawGrid.UpdateScrollBarsPos;
var
L2R : Boolean;
begin
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
if m_HScrollBar <> nil then
begin
if Height < m_HScrollBar.Height then
m_HScrollBar.Visible := false
else
m_HScrollBar.Visible := true;
if L2R then
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
else
m_HScrollBar.Width := Width - 1
end
else
begin
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
begin
m_HScrollBar.Left := Left + m_VScrollBar.Width + 1;
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
end
else
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Width := Width - 1;
end;
end;
end;
if m_VScrollBar <> nil then
begin
if Width < m_VScrollBar.Width then
m_VScrollBar.Visible := false
else
m_VScrollBar.Visible := true;
if L2R then
begin
m_VScrollBar.Left := Left + Width - m_VScrollBar.Width - 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end
else
begin
m_VScrollBar.Left := Left + 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end;
end;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMClear(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMCut(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMEARSEBKGND(var Msg: TMessage);
begin
Paint();
end;
procedure TsuiCustomDrawGrid.WMHSCROLL(var Message: TWMHScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMLBUTTONDOWN(var Message: TMessage);
begin
inherited;
m_MouseDown := true;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMLButtonUp(var Message: TMessage);
begin
inherited;
m_MouseDown := false;
end;
procedure TsuiCustomDrawGrid.WMMOUSEMOVE(var Message: TMessage);
begin
inherited;
if m_MouseDown then UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMMOUSEWHEEL(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMMOVE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.WMPaste(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMSetText(var Message: TWMSetText);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMSIZE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiCustomDrawGrid.WMUndo(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiCustomDrawGrid.WMVSCROLL(var Message: TWMVScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
{ TsuiStringGrid }
procedure TsuiStringGrid.CMBIDIMODECHANGED(var Msg: TMessage);
var
L2R : Boolean;
info : tagScrollInfo;
begin
inherited;
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
if (not L2R) and (m_HScrollBar <> nil) then
begin
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_HORZ, info);
m_HScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_HScrollBar.Min := info.nMin;
m_HScrollBar.Position := m_HScrollBar.Max - info.nPos
end;
end;
procedure TsuiStringGrid.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.CMVisibleChanged(var Msg: TMEssage);
begin
inherited;
if not Visible then
begin
if m_VScrollBar <> nil then
m_VScrollBar.Visible := Visible;
if m_HScrollBar <> nil then
m_HScrollBar.Visible := Visible;
end
else
UpdateScrollBarsPos();
end;
constructor TsuiStringGrid.Create(AOwner: TComponent);
var
i:integer;
begin
inherited;
Columns := TImpGridColumns.Create(self,TImpColumn);
For i := 1 to 5 do Columns.add;
ControlStyle := ControlStyle + [csOpaque];
BorderStyle := bsNone;
BorderWidth := 1;
UIStyle := GetSUIFormStyle(AOwner);
FocusedColor := clLime;
SelectedColor := clYellow;
ParentCtl3D := false;
m_MouseDown := false;
inherited Ctl3D := false;
end;
function TsuiStringGrid.CreateEditor: TInplaceEdit;
begin
Result := TImpGridInplaceEdit.Create(Self);
end;
procedure TsuiStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
function RowIsMultiSelected: Boolean;
var
Index: Integer;
begin
Result :=false;
{(dgMultiSelect in Options) and Datalink.Active and
FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);}
end;
var
OldActive: Integer;
Indicator: Integer;
Highlight: Boolean;
Value: string;
DrawColumn: TImpColumn;
FrameOffs: Byte;
MultiSelected: Boolean;
R : TRect;
begin
if not DefaultDrawing then
begin
inherited;
end
else
begin
R := ARect;
try
if not( gdFixed in AState) then
begin
if gdSelected in AState then
begin
Canvas.Brush.Color := m_SelectedColor;
end;
if gdFocused in AState then
begin
Canvas.Brush.Color := m_FocusedColor;
end;
if AState = [] then
Canvas.Brush.Color := Color;
Canvas.FillRect(R);
end;
finally
if gdFixed in AState then
begin
Canvas.Font.Color := m_FixedFontColor;
Canvas.TextRect(ARect, ARect.Left + 2, ARect.Top + 2, Cells[ACol, ARow]);
end;
inherited;
end;
end;
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
{ Dec(ARow, FTitleOffset);
Dec(ACol, FIndicatorOffset); }
if (gdFixed in AState) then
begin
InflateRect(ARect, -1, -1);
FrameOffs := 1;
end
else
FrameOffs := 2;
with Canvas do
begin
DrawColumn := Columns[ACol];
if gdFixed in AState then
begin
Font := DrawColumn.Title.Font;
Brush.Color := DrawColumn.Title.Color;
end
else
begin
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color;
{ if gdSelected in AState then
begin
Brush.Color := m_SelectedColor;
end;
if gdFocused in AState then
begin
Brush.Color := m_FocusedColor;
end;
if AState = [] then
Canvas.Brush.Color := Color;
} // Canvas.FillRect(R);
end;
with DrawColumn do
WriteText(Canvas, ARect, FrameOffs, FrameOffs, cells[Acol,Arow], Alignment)
end;
if (gdFixed in AState) then
begin
InflateRect(ARect, 1, 1);
Canvas.Font.Color := m_FixedFontColor;
Canvas.TextRect(ARect, ARect.Left + 2, ARect.Top + 2, Cells[ACol, ARow]);
if ARow < 1 then with DrawColumn.Title do
WriteText(Canvas, ARect, FrameOffs, FrameOffs, Caption, Alignment);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_FLAT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT or BF_FLAT);
end;
end;
procedure TsuiStringGrid.Editbuttonclick;
begin
if assigned(OnElippsisclicked) then OnElippsisclicked(self,col,row)
end;
function TsuiStringGrid.GetBGColor: TColor;
begin
Result := Color;
end;
function TsuiStringGrid.GetColCount: Integer;
begin
result := inherited colcount;
end;
function TsuiStringGrid.GetCtl3D: Boolean;
begin
Result := false;
end;
function TsuiStringGrid.GetFixedBGColor: TColor;
begin
Result := FixedColor;
end;
function TsuiStringGrid.GetFontColor: TColor;
begin
Result := Font.Color;
end;
function TsuiStringGrid.GetSelLength: Integer;
var
Selection: TSelection;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
Result := Selection.EndPos - Selection.StartPos;
end;
function TsuiStringGrid.GetSelStart: Integer;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
end;
procedure TsuiStringGrid.KeyDown(var Key: Word; Shift: TShiftState);
var coll,roww,i:integer;
begin
coll := col;
roww := row;
if key = vk_tab then begin
if not (ssAlt in Shift) then
if ssShift in Shift then
begin
Dec(coll);
if coll < FixedCols then
begin
coll := ColCount - 1;
Dec(roww);
if roww < FixedRows then roww := RowCount - 1;
end;
Shift := [];
end
else
begin
Inc(coll);
if coll >= ColCount then
begin
coll := FixedCols;
Inc(roww);
if roww >= RowCount then
begin
if (rowcount+1)*(Defaultrowheight+Gridlinewidth) > height then
begin
if not ftoomuch then if assigned(fOntoomuch) then fOntoomuch(self);
ftoomuch := true;
end else ftoomuch := false;
rowcount := rowcount +1;
if assigned(fOnNewRow) then fOnNewRow(self);
if colcount <> 0 then for i := 0 to colcount-1 do begin
cells[i,roww] := ＇＇＇＇;
end;
end;
end;
end;
end;
inherited keydown(Key,Shift);
end;
procedure TsuiStringGrid.KeyPress(var Key: Char);
var
myEdit:TEdit;
begin
if (Key=#27) or (Key=#8) then exit;
if Columns.Items[Col].EditStyle=cvInteger then
begin
if not (Key in [＇＇0＇＇..＇＇9＇＇]) then Key:=#0;
end
else if Columns.Items[Col].EditStyle=cvDouble then
begin
if not (Key in [＇＇0＇＇..＇＇9＇＇,＇＇.＇＇] ) then Key:=#0;
if (Key = ＇＇.＇＇) then
begin
if (Pos(＇＇.＇＇,Cells[Col,Row])>0) then
begin
if (SelStart+SelLength
if SelLength=0 then Key:=#0;
end;
if SelStart=0 then Key:=#0;
if (SelStart>0) then
if length(Cells[Col,Row])-SelStart -SelLength>2 then Key:=#0;
end;
if (SelStart>0) and (SelLength=0) then
if (pos(＇＇.＇＇,Cells[Col,Row])>0) and (SelStart>=pos(＇＇.＇＇,Cells[Col,Row])) then
if length(Cells[Col,Row])-pos(＇＇.＇＇,Cells[Col,Row])>=2 then Key:=#0;
end;
inherited;
end;
procedure TsuiStringGrid.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (
(Operation = opRemove) and
(AComponent = m_FileTheme)
)then
begin
m_FileTheme := nil;
SetUIStyle(SUI_THEME_DEFAULT);
end;
if (
(Operation = opRemove) and
(AComponent = m_HScrollBar)
)then
begin
m_HScrollBar := nil;
UpdateInnerScrollBars();
end;
if (
(Operation = opRemove) and
(AComponent = m_VScrollBar)
)then
begin
m_VScrollBar := nil;
UpdateInnerScrollBars();
end;
end;
procedure TsuiStringGrid.OnHScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, m_HScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiStringGrid.OnVScrollBarChange(Sender: TObject);
begin
if m_SelfChanging then
Exit;
m_UserChanging := true;
SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, m_VScrollBar.Position), 0);
Invalidate;
m_UserChanging := false;
end;
procedure TsuiStringGrid.Paint;
begin
inherited;
DrawControlBorder(self, m_BorderColor, Color, false);
end;
procedure TsuiStringGrid.SetBGColor(const Value: TColor);
begin
Color := Value;
end;
procedure TsuiStringGrid.SetBorderColor(const Value: TColor);
begin
m_BorderColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetColCount(Col: Integer);
var oldcol:Longint;
begin
oldcol := inherited Colcount;
if oldcol <> col then begin
if col > oldcol then begin
while oldcol < col do begin
columns.add;
inc(oldcol);
end;
end
else
begin
while oldcol > col do begin
columns.items[columns.count-1].free;
dec(oldcol);
end;
end;
end;
inherited colcount := col;
end;
procedure TsuiStringGrid.SetEditText(ACol, ARow: Integer;
const Value: string);
begin
if Columns.Items[Acol].EditStyle=cvInteger then
begin
try
if trim(Value)<>＇＇＇＇ then strtoint(Value);
except
on e:exception do Cells[ACol, ARow] :=＇＇0＇＇;
end;
end
else if Columns.Items[Acol].EditStyle=cvDouble then
begin
try
if trim(Value)<>＇＇＇＇ then strtofloat(Value);
except
on e:exception do Cells[ACol, ARow] :=＇＇0.00＇＇;
end;
end
else Cells[ACol, ARow] := Value;
inherited;
end;
procedure TsuiStringGrid.SetFileTheme(const Value: TsuiFileTheme);
begin
m_FileTheme := Value;
SetUIStyle(m_UIStyle);
end;
procedure TsuiStringGrid.SetFixedBGColor(const Value: TColor);
begin
FixedColor := Value;
end;
procedure TsuiStringGrid.SetFixedFontColor(const Value: TColor);
begin
m_FixedFontColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetFocusedColor(const Value: TColor);
begin
m_FocusedColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetFontColor(const Value: TColor);
begin
Font.Color := Value;
Repaint();
end;
procedure TsuiStringGrid.SetHScrollBar(const Value: TsuiScrollBar);
begin
if m_HScrollBar = Value then
Exit;
if m_HScrollBar <> nil then
begin
m_HScrollBar.OnChange := nil;
m_HScrollBar.LineButton := 0;
m_HScrollBar.Max := 100;
m_HScrollBar.Enabled := true;
end;
m_HScrollBar := Value;
if m_HScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_HScrollBar.Orientation := suiHorizontal;
m_HScrollBar.OnChange := OnHScrollBarChange;
m_HScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.SetSelectedColor(const Value: TColor);
begin
m_SelectedColor := Value;
Repaint();
end;
procedure TsuiStringGrid.SetSelLength(Value: Integer);
var
Selection: TSelection;
begin
SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
Selection.EndPos := Selection.StartPos + Value;
SendMessage(Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
SendMessage(Handle, EM_SCROLLCARET, 0,0);
end;
procedure TsuiStringGrid.SetSelStart(Value: Integer);
begin
SendMessage(Handle, EM_SETSEL, Value, Value);
end;
procedure TsuiStringGrid.SetUIStyle(const Value: TsuiUIStyle);
var
OutUIStyle : TsuiUIStyle;
begin
m_UIStyle := Value;
if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
begin
BorderColor := m_FileTheme.GetColor(SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := m_FileTheme.GetColor(SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := m_FileTheme.GetColor(SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := m_FileTheme.GetColor(SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end
else
begin
BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
FixedColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BACKGROUND_COLOR);
FixedFontColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
Font.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_FONT_COLOR);
if (Font.Color = clWhite) then
Font.Color := clBlack;
end;
if m_VScrollBar <> nil then
m_VScrollBar.UIStyle := OutUIStyle;
if m_HScrollBar <> nil then
m_HScrollBar.UIStyle := OutUIStyle;
end;
procedure TsuiStringGrid.SetVScrollBar(const Value: TsuiScrollBar);
begin
if m_VScrollBar = Value then
Exit;
if m_VScrollBar <> nil then
begin
m_VScrollBar.OnChange := nil;
m_VScrollBar.LineButton := 0;
m_VScrollBar.Max := 100;
m_VScrollBar.Enabled := true;
end;
m_VScrollBar := Value;
if m_VScrollBar = nil then
begin
UpdateInnerScrollBars();
Exit;
end;
m_VScrollBar.Orientation := suiVertical;
m_VScrollBar.OnChange := OnVScrollBArChange;
m_VScrollBar.BringToFront();
UpdateInnerScrollBars();
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.UpdateInnerScrollBars;
begin
if (m_VScrollBar <> nil) and (m_HScrollBar <> nil) then
ScrollBars := ssBoth
else if (m_VScrollBar <> nil) and (m_HScrollBar = nil) then
ScrollBars := ssVertical
else if (m_HScrollBar <> nil) and (m_VScrollBar = nil) then
ScrollBars := ssHorizontal
else
ScrollBars := ssNone;
end;
procedure TsuiStringGrid.UpdateScrollBars;
var
info : tagScrollInfo;
barinfo : tagScrollBarInfo;
begin
if m_UserChanging then
Exit;
m_SelfChanging := true;
if m_HScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), barinfo) then
begin
m_HScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_HScrollBar.LineButton := 0;
m_HScrollBar.Enabled := false;
m_HScrollBar.SliderVisible := false;
end
else
begin
m_HScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_HScrollBar.SmallChange := 3 * m_HScrollBar.PageSize;
m_HScrollBar.Enabled := true;
m_HScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_HORZ, info);
m_HScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_HScrollBar.Min := info.nMin;
m_HScrollBar.Position := info.nPos
end;
if m_VScrollBar <> nil then
begin
barinfo.cbSize := SizeOf(barinfo);
if not SUIGetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), barinfo) then
begin
m_VScrollBar.Visible := false;
end
else if (barinfo.rgstate[0] = STATE_SYSTEM_INVISIBLE) or
(barinfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) or
(not Enabled) then
begin
m_VScrollBar.LineButton := 0;
m_VScrollBar.Enabled := false;
m_VScrollBar.SliderVisible := false;
end
else
begin
m_VScrollBar.LineButton := abs(barinfo.xyThumbBottom - barinfo.xyThumbTop);
m_VScrollBar.Enabled := true;
m_VScrollBar.SliderVisible := true;
end;
info.cbSize := SizeOf(info);
info.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_VERT, info);
m_VScrollBar.Max := info.nMax - Integer(info.nPage) + 1;
m_VScrollBar.Min := info.nMin;
m_VScrollBar.Position := info.nPos;
end;
m_SelfChanging := false;
end;
procedure TsuiStringGrid.UpdateScrollBarsPos;
var
L2R : Boolean;
begin
L2R := ((BidiMode = bdLeftToRight) or (BidiMode = bdRightToLeftReadingOnly)) or (not SysLocale.MiddleEast);
if m_HScrollBar <> nil then
begin
if Height < m_HScrollBar.Height then
m_HScrollBar.Visible := false
else
m_HScrollBar.Visible := true;
if L2R then
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
else
m_HScrollBar.Width := Width - 1
end
else
begin
m_HScrollBar.Top := Top + Height - m_HScrollBar.Height - 1;
if m_VScrollBar <> nil then
begin
m_HScrollBar.Left := Left + m_VScrollBar.Width + 1;
m_HScrollBar.Width := Width - 1 - m_VScrollBar.Width
end
else
begin
m_HScrollBar.Left := Left + 1;
m_HScrollBar.Width := Width - 1;
end;
end;
end;
if m_VScrollBar <> nil then
begin
if Width < m_VScrollBar.Width then
m_VScrollBar.Visible := false
else
m_VScrollBar.Visible := true;
if L2R then
begin
m_VScrollBar.Left := Left + Width - m_VScrollBar.Width - 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end
else
begin
m_VScrollBar.Left := Left + 1;
m_VScrollBar.Top := Top + 1;
if m_HScrollBar <> nil then
m_VScrollBar.Height := Height - 1 - m_HScrollBar.Height
else
m_VScrollBar.Height := Height - 1;
end;
end;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMClear(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMCut(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMEARSEBKGND(var Msg: TMessage);
begin
Paint();
end;
procedure TsuiStringGrid.WMHSCROLL(var Message: TWMHScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMLBUTTONDOWN(var Message: TMessage);
begin
inherited;
m_MouseDown := true;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMLButtonUp(var Message: TMessage);
begin
inherited;
m_MouseDown := false;
end;
procedure TsuiStringGrid.WMMOUSEMOVE(var Message: TMessage);
begin
inherited;
if m_MouseDown then UpdateScrollBars();
end;
procedure TsuiStringGrid.WMMOUSEWHEEL(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMMOVE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.WMPaste(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMSetText(var Message: TWMSetText);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMSIZE(var Msg: TMessage);
begin
inherited;
UpdateScrollBarsPos();
end;
procedure TsuiStringGrid.WMUndo(var Message: TMessage);
begin
inherited;
UpdateScrollBars();
end;
procedure TsuiStringGrid.WMVSCROLL(var Message: TWMVScroll);
begin
inherited;
if m_UserChanging then
Exit;
UpdateScrollBars();
end;
{ TImpColumnTitle }
procedure TImpColumnTitle.Assign(Source: TPersistent);
begin
if Source is TImpColumnTitle then
begin
if cvTitleAlignment in TImpColumnTitle(Source).FColumn.FAssignedValues then
Alignment := TImpColumnTitle(Source).Alignment;
if cvTitleColor in TImpColumnTitle(Source).FColumn.FAssignedValues then
Color := TImpColumnTitle(Source).Color;
if cvTitleCaption in TImpColumnTitle(Source).FColumn.FAssignedValues then
Caption := TImpColumnTitle(Source).Caption;
if cvTitleFont in TImpColumnTitle(Source).FColumn.FAssignedValues then
Font := TImpColumnTitle(Source).Font;
end
else
inherited Assign(Source);
end;
constructor TImpColumnTitle.Create(Column: TImpColumn);
begin
inherited Create;
FColumn := Column;
FFont := TFont.Create;
FFont.Assign(DefaultFont);
FFont.OnChange := FontChanged;
end;
function TImpColumnTitle.DefaultAlignment: TAlignment;
begin
Result := taLeftJustify;
end;
function TImpColumnTitle.DefaultCaption: string;
//var
{ Field: TField;}
begin
{ Field := FColumn.Field;
if Assigned(Field) then
Result := Field.DisplayName
else }
{ Result := FColumn.FieldName;}
end;
function TImpColumnTitle.DefaultColor: TColor;
var
Grid: TsuiStringGrid;
begin
Grid := FColumn.GetGrid;
if Assigned(Grid) then
Result := Grid.FixedColor
else
Result := clBtnFace;
end;
function TImpColumnTitle.DefaultDouble: double;
begin
Result := 0;
end;
function TImpColumnTitle.DefaultFont: TFont;
var
Grid: TsuiStringGrid;
begin
Grid := FColumn.GetGrid;
{if Assigned(Grid) then
Result := Grid.TitleFont
else }
Result := FColumn.Font;
end;
destructor TImpColumnTitle.Destroy;
begin
FFont.Free;
inherited Destroy;
end;
procedure TImpColumnTitle.FontChanged(Sender: TObject);
begin
Include(FColumn.FAssignedValues, cvTitleFont);
FColumn.Changed(True);
end;
function TImpColumnTitle.GetAlignment: TAlignment;
begin
if cvTitleAlignment in FColumn.FAssignedValues then
Result := FAlignment
else
Result := DefaultAlignment;
end;
function TImpColumnTitle.GetCaption: string;
begin
if cvTitleCaption in FColumn.FAssignedValues then
Result := FCaption
else
Result := DefaultCaption;
end;
function TImpColumnTitle.GetColor: TColor;
begin
if cvTitleColor in FColumn.FAssignedValues then
Result := FColor
else
Result := DefaultColor;
end;
function TImpColumnTitle.GetFont: TFont;
var
Save: TNotifyEvent;
Def: TFont;
begin
if not (cvTitleFont in FColumn.FAssignedValues) then
begin
Def := DefaultFont;
if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
begin
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
end;
end;
Result := FFont;
end;
function TImpColumnTitle.IsAlignmentStored: Boolean;
begin
Result := (cvTitleAlignment in FColumn.FAssignedValues) and
(FAlignment <> DefaultAlignment);
end;
function TImpColumnTitle.IsCaptionStored: Boolean;
begin
Result := (cvTitleCaption in FColumn.FAssignedValues) and
(FCaption <> DefaultCaption);
end;
function TImpColumnTitle.IsColorStored: Boolean;
begin
Result := (cvTitleColor in FColumn.FAssignedValues) and
(FColor <> DefaultColor);
end;
function TImpColumnTitle.IsFontStored: Boolean;
begin
Result := (cvTitleFont in FColumn.FAssignedValues);
end;
procedure TImpColumnTitle.RefreshDefaultFont;
var
Save: TNotifyEvent;
begin
if (cvTitleFont in FColumn.FAssignedValues) then Exit;
Save := FFont.OnChange;
FFont.OnChange := nil;
try
FFont.Assign(DefaultFont);
finally
FFont.OnChange := Save;
end;
end;
procedure TImpColumnTitle.RestoreDefaults;
var
FontAssigned: Boolean;
begin
FontAssigned := cvTitleFont in FColumn.FAssignedValues;
FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
FCaption := ＇＇＇＇;
RefreshDefaultFont;
{ If font was assigned, changing it back to default may affect grid title
height, and title height changes require layout and redraw of the grid. }
FColumn.Changed(FontAssigned);
end;
procedure TImpColumnTitle.SetAlignment(Value: TAlignment);
begin
if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
FAlignment := Value;
Include(FColumn.FAssignedValues, cvTitleAlignment);
FColumn.Changed(False);
end;
procedure TImpColumnTitle.SetCaption(const Value: string);
begin
if (cvTitleCaption in FColumn.FAssignedValues) and (Value = FCaption) then Exit;
FCaption := Value;
Include(FColumn.FAssignedValues, cvTitleCaption);
FColumn.Changed(False);
end;
procedure TImpColumnTitle.SetColor(Value: TColor);
begin
if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
FColor := Value;
Include(FColumn.FAssignedValues, cvTitleColor);
FColumn.Changed(False);
end;
procedure TImpColumnTitle.SetFont(Value: TFont);
begin
FFont.Assign(Value);
end;
{ TImpColumn }
procedure TImpColumn.Assign(Source: TPersistent);
begin
if Source is TImpColumn then
begin
if Assigned(Collection) then Collection.BeginUpdate;
try
RestoreDefaults;
//FieldName := TImpColumn(Source).FieldName;
if cvColor in TImpColumn(Source).AssignedValues then
Color := TImpColumn(Source).Color;
if cvWidth in TImpColumn(Source).AssignedValues then
Width := TImpColumn(Source).Width;
if cvFont in TImpColumn(Source).AssignedValues then
Font := TImpColumn(Source).Font;
if cvImeMode in TImpColumn(Source).AssignedValues then
ImeMode := TImpColumn(Source).ImeMode;
if cvImeName in TImpColumn(Source).AssignedValues then
ImeName := TImpColumn(Source).ImeName;
if cvAlignment in TImpColumn(Source).AssignedValues then
Alignment := TImpColumn(Source).Alignment;
if cvReadOnly in TImpColumn(Source).AssignedValues then
ReadOnly := TImpColumn(Source).ReadOnly;
Title := TImpColumn(Source).Title;
DropDownRows := TImpColumn(Source).DropDownRows;
ButtonStyle := TImpColumn(Source).ButtonStyle;
PickList := TImpColumn(Source).PickList;
//PopupMenu := TImpColumn(Source).PopupMenu;
finally
if Assigned(Collection) then Collection.EndUpdate;
end;
end
else
inherited Assign(Source);
end;
constructor TImpColumn.Create(Collection: TCollection);
var
Grid: TsuiStringGrid;
begin
Grid := nil;
if Assigned(Collection) and (Collection is TImpGridColumns) then
Grid := TImpGridColumns(Collection).Grid;
{if Assigned(Grid) then
Grid.BeginLayout; }
try
inherited Create(Collection);
FDropDownRows := 7;
FButtonStyle := cbsNone;
FFont := TFont.Create;
FFont.Assign(DefaultFont);
FFont.OnChange := FontChanged;
FImeMode := imDontCare;
FImeName := Screen.DefaultIme;
FTitle := CreateTitle;
//FPicklist := Tstrings.create;
finally
if Assigned(Grid) then
// Grid.EndLayout;
end;
end;
function TImpColumn.CreateTitle: TImpColumnTitle;
begin
Result := TImpColumnTitle.Create(Self);
end;
function TImpColumn.DefaultAlignment: TAlignment;
begin
Result := taLeftJustify;
end;
function TImpColumn.DefaultColor: TColor;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.Color
else
Result := clWindow;
end;
function TImpColumn.DefaultFont: TFont;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.Font
else
Result := FFont;
end;
function TImpColumn.DefaultImeMode: TImeMode;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.ImeMode
else
Result := FImeMode;
end;
function TImpColumn.DefaultImeName: TImeName;
var
Grid: TsuiStringGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.ImeName
else
Result := FImeName;
end;
function TImpColumn.DefaultReadOnly: Boolean;
begin
Result := false;
end;
function TImpColumn.DefaultWidth: Integer;
begin
if GetGrid = nil then
begin
Result := 64;
Exit;
end;
with GetGrid do
begin
Result := DefaultColWidth;
end;
end;
destructor TImpColumn.Destroy;
begin
FTitle.Free;
FFont.Free;
FPickList.Free;
inherited Destroy;
end;
procedure TImpColumn.FontChanged(Sender: TObject);
begin
Include(FAssignedValues, cvFont);
Title.RefreshDefaultFont;
Changed(False);
end;
function TImpColumn.GetAlignment: TAlignment;
begin
if cvAlignment in FAssignedValues then
Result := FAlignment
else
Result := DefaultAlignment;
end;
function TImpColumn.GetColor: TColor;
begin
if cvColor in FAssignedValues then
Result := FColor
else
Result := DefaultColor;
end;
function TImpColumn.GetDisplayName: string;
begin
Result := inherited GetDisplayName;
end;
function TImpColumn.GetFont: TFont;
var
Save: TNotifyEvent;
begin
if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
begin
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
end;
Result := FFont;
end;
function TImpColumn.GetGrid: TsuiStringGrid;
begin
if Assigned(Collection) and (Collection is TImpGridColumns) then
Result := TImpGridColumns(Collection).Grid
else
Result := nil;
end;
function TImpColumn.GetImeMode: TImeMode;
begin
if cvImeMode in FAssignedValues then
Result := FImeMode
else
Result := DefaultImeMode;
end;
function TImpColumn.GetImeName: TImeName;
begin
if cvImeName in FAssignedValues then
Result := FImeName
else
Result := DefaultImeName;
end;
function TImpColumn.GetPickList: TStrings;
begin
if FPickList = nil then
FPickList := TStringList.Create;
Result := FPickList;
end;
function TImpColumn.GetReadOnly: Boolean;
begin
if cvReadOnly in FAssignedValues then
Result := FReadOnly
else
Result := DefaultReadOnly;
end;
function TImpColumn.GetWidth: Integer;
begin
if cvWidth in FAssignedValues then
Result := FWidth
else
Result := DefaultWidth;
end;
function TImpColumn.IsAlignmentStored: Boolean;
begin
Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
end;
function TImpColumn.IsColorStored: Boolean;
begin
Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
end;
function TImpColumn.IsFontStored: Boolean;
begin
Result := (cvFont in FAssignedValues);
end;
function TImpColumn.IsImeModeStored: Boolean;
begin
Result := (cvImeMode in FAssignedValues) and (FImeMode <> DefaultImeMode);
end;
function TImpColumn.IsImeNameStored: Boolean;
begin
Result := (cvImeName in FAssignedValues) and (FImeName <> DefaultImeName);
end;
function TImpColumn.IsReadOnlyStored: Boolean;
begin
Result := (cvReadOnly in FAssignedValues) and (FReadOnly <> DefaultReadOnly);
end;
function TImpColumn.IsWidthStored: Boolean;
begin
Result := (cvWidth in FAssignedValues) and (FWidth <> DefaultWidth);
end;
procedure TImpColumn.RefreshDefaultFont;
var
Save: TNotifyEvent;
begin
if cvFont in FAssignedValues then Exit;
Save := FFont.OnChange;
FFont.OnChange := nil;
try
FFont.Assign(DefaultFont);
finally
FFont.OnChange := Save;
end;
end;
procedure TImpColumn.RestoreDefaults;
var
FontAssigned: Boolean;
begin
FontAssigned := cvFont in FAssignedValues;
FTitle.RestoreDefaults;
FAssignedValues := [];
RefreshDefaultFont;
FPickList.Free;
FPickList := nil;
ButtonStyle := cbsNone;
Changed(FontAssigned);
end;
procedure TImpColumn.SetAlignment(Value: TAlignment);
begin
if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
FAlignment := Value;
Include(FAssignedValues, cvAlignment);
Changed(False);
end;
procedure TImpColumn.SetButtonStyle(Value: TImpColumnButtonStyle);
begin
if Value = FButtonStyle then Exit;
FButtonStyle := Value;
Changed(False);
end;
procedure TImpColumn.SetColor(Value: TColor);
begin
if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
FColor := Value;
Include(FAssignedValues, cvColor);
Changed(False);
end;
procedure TImpColumn.SetEditStyle(Value: TImpColumnEditStyle);
begin
if Value = FEditStyle then Exit;
FEditStyle := Value;
Changed(False);
end;
procedure TImpColumn.SetFont(Value: TFont);
begin
FFont.Assign(Value);
Include(FAssignedValues, cvFont);
Changed(False);
end;
procedure TImpColumn.SetImeMode(Value: TImeMode);
begin
if (cvImeMode in FAssignedValues) or (Value <> DefaultImeMode) then
begin
FImeMode := Value;
Include(FAssignedValues, cvImeMode);
end;
Changed(False);
end;
procedure TImpColumn.SetImeName(Value: TImeName);
begin
if (cvImeName in FAssignedValues) or (Value <> DefaultImeName) then
begin
FImeName := Value;
Include(FAssignedValues, cvImeName);
end;
Changed(False);
end;
procedure TImpColumn.SetPickList(Value: TStrings);
begin
if Value = nil then
begin
FPickList.Free;
FPickList := nil;
Exit;
end;
PickList.Assign(Value);
end;
procedure TImpColumn.SetReadOnly(Value: Boolean);
begin
if (cvReadOnly in FAssignedValues) and (Value = FReadOnly) then Exit;
FReadOnly := Value;
Include(FAssignedValues, cvReadOnly);
Changed(False);
end;
procedure TImpColumn.SetTitle(Value: TImpColumnTitle);
begin
FTitle.Assign(Value);
end;
procedure TImpColumn.SetWidth(Value: Integer);
begin
if (cvWidth in FAssignedValues) or (Value <> DefaultWidth) then
begin
FWidth := Value;
Include(FAssignedValues, cvWidth);
end;
Changed(False);
end;
{ TImpGridColumns }
function TImpGridColumns.Add: TImpColumn;
begin
Result := TImpColumn(inherited Add);
end;
constructor TImpGridColumns.Create(Grid: TsuiStringGrid;
ColumnClass: TImpColumnClass);
begin
inherited Create(ColumnClass);
FGrid := Grid;
end;
function TImpGridColumns.GetCount: Integer;
begin
Result := inherited Count;
end;
function TImpGridColumns.GeTImpColumn(Index: Integer): TImpColumn;
begin
Result := TImpColumn(inherited Items[Index]);
end;
function TImpGridColumns.GetOwner: TPersistent;
begin
Result := FGrid;
end;
function TImpGridColumns.GetState: TImpGridColumnsState;
begin
Result := TImpGridColumnsState((Count > 0)) ;
end;
procedure TImpGridColumns.LoadFromFile(const Filename: string);
var
S: TFileStream;
begin
S := TFileStream.Create(Filename, fmOpenRead);
try
LoadFromStream(S);
finally
S.Free;
end;
end;
type
TImpColumnsWrapper = class(TComponent)
private
FColumns: TImpGridColumns;
published
property Columns: TImpGridColumns read FColumns write FColumns;
end;
procedure TImpGridColumns.LoadFromStream(S: TStream);
var
Wrapper: TImpColumnsWrapper;
begin
end;
procedure TImpGridColumns.RebuildColumns;
var
I: Integer;
begin
end;
procedure TImpGridColumns.RestoreDefaults;
var
I: Integer;
begin
BeginUpdate;
try
for I := 0 to Count-1 do
Items[I].RestoreDefaults;
finally
EndUpdate;
end;
end;
procedure TImpGridColumns.SaveToFile(const Filename: string);
var
S: TStream;
begin
S := TFileStream.Create(Filename, fmCreate);
try
SaveToStream(S);
finally
S.Free;
end;
end;
procedure TImpGridColumns.SaveToStream(S: TStream);
var
Wrapper: TImpColumnsWrapper;
begin
Wrapper := TImpColumnsWrapper.Create(nil);
try
Wrapper.Columns := Self;
S.WriteComponent(Wrapper);
finally
Wrapper.Free;
end;
end;
procedure TImpGridColumns.SeTImpColumn(Index: Integer; Value: TImpColumn);
begin
Items[Index].Assign(Value);
end;
procedure TImpGridColumns.SetState(NewState: TImpGridColumnsState);
begin
if NewState = State then Exit;
if NewState = csDefault then
Clear
else
RebuildColumns;
end;
procedure TImpGridColumns.Update(Item: TCollectionItem);
var
Raw: Integer;
begin
end;
{ TImpGridInplaceEdit }
procedure TImpGridInplaceEdit.BoundsChanged;
var
R: TRect;
begin
SetRect(R, 2, 2, Width - 2, Height);
if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
SendMessage(Handle, EM_SCROLLCARET, 0, 0);
if SysLocale.Fareast then
SetImeCompositionWindow(Font, R.Left, R.Top);
end;
procedure TImpGridInplaceEdit.CloseUp(Accept: Boolean);
var
//MasterField: TField;
ListValue: Variant;
begin
if FListVisible then
begin
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
{ if FActiveList = FDataList then
ListValue := FDataList.KeyValue
else }
if FPickList.ItemIndex <> -1 then
ListValue := FPickList.Items[FPicklist.ItemIndex];
SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FListVisible := False;
Invalidate;
if Accept then
if (not VarIsNull(ListValue)) and EditCanModify then
{with TsuiStringGrid(Grid) do}
Text := ListValue;
end;
end;
procedure TImpGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
CloseUp(False);
end;
constructor TImpGridInplaceEdit.Create(Owner: TComponent);
begin
inherited Create(Owner);
//FLookupSource := TDataSource.Create(Self);
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
FEditStyle := esEllipsis;
end;
procedure TImpGridInplaceEdit.DoDropDownKeys(var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_UP, VK_DOWN:
if ssAlt in Shift then
begin
if FListVisible then CloseUp(True) else DropDown;
Key := 0;
end;
VK_RETURN, VK_ESCAPE:
if FListVisible and not (ssAlt in Shift) then
begin
CloseUp(Key = VK_RETURN);
Key := 0;
end;
end;
end;
procedure TImpGridInplaceEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
Column: TImpColumn;
str : Tstrings;
begin
if not FListVisible and Assigned(FActiveList) then
begin
FActiveList.Width := Width;
with TsuiStringGrid(Grid) do
Column := Columns[col];
begin
FPickList.Color := Color;
FPickList.Font := Font;
FPickList.Items := Column.Picklist;
if assigned(TsuiStringGrid(Grid).OnPickListDropDown) then begin
str := Tstringlist.create;
str.assign(fpicklist.items);
TsuiStringGrid(Grid).OnPickListDropDown(Self,TsuiStringgrid(Grid).col,TsuiStringgrid(Grid).row,
str);
fpicklist.items.Assign(str);
end;
if FPickList.Items.Count >= Column.DropDownRows then
FPickList.Height := Column.DropDownRows * FPickList.ItemHeight + 4
else
FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
// if Column.Field.IsNull then
FPickList.ItemIndex := -1;
// else
// FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Value);
J := FPickList.ClientWidth;
for I := 0 to FPickList.Items.Count - 1 do
begin
Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
if Y > J then J := Y+10;
end;
FPickList.ClientWidth := J;
end;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FListVisible := True;
Invalidate;
Windows.SetFocus(Handle);
end;
end;
type
TWinControlCracker = class(TWinControl) end;
procedure TImpGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
begin
TsuiStringGrid(Grid).EditButtonClick;
KillMessage(Handle, WM_CHAR);
end
else
inherited KeyDown(Key, Shift);
end;
procedure TImpGridInplaceEdit.ListMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;
procedure TImpGridInplaceEdit.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) and (FEditStyle <> esSimple) and
PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
begin
if FListVisible then
CloseUp(False)
else
begin
MouseCapture := True;
FTracking := True;
TrackButton(X, Y);
if Assigned(FActiveList) then DropDown;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TImpGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ListPos: TPoint;
MousePos: TSmallPoint;
begin
if FTracking then
begin
TrackButton(X, Y);
if FListVisible then
begin
ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
if PtInRect(FActiveList.ClientRect, ListPos) then
begin
StopTracking;
MousePos := PointToSmallPoint(ListPos);
SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
Exit;
end;
end;
end;
inherited MouseMove(Shift, X, Y);
end;
procedure TImpGridInplaceEdit.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
WasPressed: Boolean;
begin
WasPressed := FPressed;
StopTracking;
if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
TsuiStringGrid(Grid).EditButtonClick;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TImpGridInplaceEdit.PaintWindow(DC: HDC);
var
R: TRect;
Flags: Integer;
W: Integer;
begin
if FEditStyle <> esSimple then
begin
SetRect(R, Width - FButtonWidth, 0, Width, Height);
Flags := 0;
if FEditStyle in [esDataList, esPickList] then
begin
if FActiveList = nil then
Flags := DFCS_INACTIVE
else if FPressed then
Flags := DFCS_FLAT or DFCS_PUSHED;
DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
end
else { esEllipsis }
begin
if FPressed then
Flags := BF_FLAT;
DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags or BF_FLAT);
Flags := ((R.Right - R.Left) shr 1) + Ord(FPressed);
W := Height shr 3;
if W = 0 then W := 1;
PatBlt(DC, R.Left + Flags, R.Top + 10, 1, 1, BLACKNESS);
PatBlt(DC, R.Left + Flags-3, R.Top + 10, 1, 1, BLACKNESS);
PatBlt(DC, R.Left + Flags+3, R.Top + 10, 1, 1, BLACKNESS);
end;
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
inherited PaintWindow(DC);
end;
procedure TImpGridInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
// if Value = FEditStyle then Exit;
FEditStyle := Value;
case Value of
esPickList:
begin
if FPickList = nil then
begin
FPickList := TPopupListbox.Create(Self);
FPickList.Visible := False;
FPickList.Parent := Self;
FPickList.OnMouseUp := ListMouseUp;
FPickList.IntegralHeight := True;
FPickList.ItemHeight := 11;
end;
FActiveList := FPickList;
end;
{ esDataList:
begin
if FDataList = nil then
begin
FDataList := TPopupDataList.Create(Self);
FDataList.Visible := False;
FDataList.Parent := Self;
FDataList.OnMouseUp := ListMouseUp;
end;
FActiveList := FDataList;
end;}
else { cbsNone, cbsEllipsis, or read only field }
FActiveList := nil;
end;
with TsuiStringGrid(Grid) do
Self.ReadOnly := Columns[col].ReadOnly;
Repaint;
end;
procedure TImpGridInplaceEdit.StopTracking;
begin
if FTracking then
begin
TrackButton(-1, -1);
FTracking := False;
MouseCapture := False;
end;
end;
procedure TImpGridInplaceEdit.TrackButton(X, Y: Integer);
var
NewState: Boolean;
R: TRect;
begin
SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
NewState := PtInRect(R, Point(X, Y));
if FPressed <> NewState then
begin
FPressed := NewState;
InvalidateRect(Handle, @R, False);
end;
end;
procedure TImpGridInplaceEdit.UpdateContents;
var
Column: TImpColumn;
NewStyle: TEditStyle;
{MasterField: TField; }
begin
with TsuiStringgrid(Grid) do
Column := Columns[col];
NewStyle := esSimple;
case Column.ButtonStyle of
cbsEllipsis: NewStyle := esEllipsis;
cbsPicklist: begin
NewStyle := esPickList;
{ if Assigned(Column.Field) then
with Column.Field do
begin
{ Show the dropdown button only if the field is editable }
{ if FieldKind = fkLookup then
begin
MasterField := Dataset.FieldByName(KeyFields);
{ Column.DefaultReadonly will always be True for a lookup field.
Test if Column.ReadOnly has been assigned a value of True }
{ if Assigned(MasterField) and MasterField.CanModify and
not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
with TCustomDBGrid(Grid) do
if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
NewStyle := esDataList
end
else
if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
not Column.Readonly then
NewStyle := esPickList;
end;}
end;
end;
EditStyle := NewStyle;
inherited UpdateContents;
end;
procedure TImpGridInplaceEdit.WMCancelMode(var Message: TMessage);
begin
StopTracking;
inherited;
end;
procedure TImpGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
if SysLocale.FarEast then
begin
ImeName := Screen.DefaultIme;
ImeMode := imDontCare;
end;
inherited;
CloseUp(False);
end;
procedure TImpGridInplaceEdit.WMLButtonDblClk(
var Message: TWMLButtonDblClk);
begin
with Message do
if (FEditStyle <> esSimple) and
PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
Exit;
inherited;
end;
procedure TImpGridInplaceEdit.WMPaint(var Message: TWMPaint);
begin
PaintHandler(Message);
end;
procedure TImpGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
P: TPoint;
begin
GetCursorPos(P);
if (FEditStyle <> esSimple) and
PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), ScreenToClient(P)) then
Windows.SetCursor(LoadCursor(0, idc_Arrow))
else
inherited;
end;
procedure TImpGridInplaceEdit.WndProc(var Message: TMessage);
begin
case Message.Msg of
wm_KeyDown, wm_SysKeyDown, wm_Char:
if EditStyle in [esPickList, esDataList] then
with TWMKey(Message) do
begin
//DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
if (CharCode <> 0) and FListVisible then
begin
with TMessage(Message) do
SendMessage(FActiveList.Handle, Msg, WParam, LParam);
Exit;
end;
end
end;
inherited;
end;
{ TPopupListbox }
procedure TPopupListbox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TPopupListbox.CreateWnd;
begin
inherited CreateWnd;
Windows.SetParent(Handle, 0);
CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;
procedure TPopupListbox.KeyPress(var Key: Char);
var
TickCount: Integer;
begin
case Key of
#8, #27: FSearchText := ＇＇＇＇;
#32..#255:
begin
TickCount := GetTickCount;
if TickCount - FSearchTickCount > 2000 then FSearchText := ＇＇＇＇;
FSearchTickCount := TickCount;
if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
Key := #0;
end;
end;
inherited Keypress(Key);
end;
procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
TImpGridInplaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;
end.
11楼: 谢谢haiyuinfo,
当行高或列宽变化时,listView的宽高会随着改变吗 ？
联系我们
