wwdbigrdtest.pas

InfoPower_Studio 2007 v5.0.1.3 banben

    procedure TopLeftChanged; override;
    function GetClientRect: TRect; override;
    procedure Paint; override;

    function GetControlType: TStrings;
    procedure GetControlInfo(AFieldName: string;
       var AControlType: string; var AParameters: string); virtual;
    procedure DoFieldChanged(Field: TField); virtual;
    procedure DoUpdateFooter; virtual;
    Function GetFooterRect: TRect; virtual;
    procedure CheckFooterUpdate; virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure FreeHintWindow; virtual;
    Function CreateHintWindow(AField: TField): THintWindow; virtual;
    procedure ValidationErrorUsingMask(Field: TField); virtual;
    procedure ChangeOrientation(RightToLeftOrientation: Boolean);
    procedure DrawLines; virtual;
    procedure PaintClickedTitleButton; virtual;
    function AdjustBoundsRect(ACurrentCustomEdit: TWinControl): boolean;
    procedure CalcSizingState(X, Y: Integer; var State: TGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer;
      var FixedInfo: TGridDrawInfo); override;
    procedure InitCacheColInfo; virtual;

  public
    AlternatePaintBuffering: boolean;
    SkipHideControls: boolean;  { IP Internal - Set by TwwDBLookupCombo DropDown method }
    SkipDataChange: boolean;    { IP Internal - Set by TwwDBLookupComboDlg }
    AlwaysShowControls: boolean; { Undocumented: when true controls will display even when grid is readonly}
//    DragImages: TImageList;
//    Indicators: TImageList;
    MinRowHeightPercent:Integer;  // Original rowheightpercent before user changes it

    property RowOffset: integer read FRowOffset write SetRowOffset;
    property TitleOffset: byte read FTitleOffset;
    property CompareBookmarksAltMethod: boolean read
                FCompareBookmarksAltMethod write FCompareBookmarksAltMethod default false;

//    OriginalCellText: string;

    procedure FillWithBlendBitmap(TempRect: TRect; CurRelRow: integer;
       FillColor: TColor=clNone); virtual;
    procedure FillWithFixedBitmap(TempRect: TRect; CurRelRow: integer;
       FillColor: TColor=clNone); virtual;
    procedure UpdateCustomEdit;
    procedure ResetProportionalWidths;
    Function ShouldShowCustomControls: boolean;
    function CanEditGrid: Boolean; virtual;
    procedure ClearURLPaint;
    Function ActiveExpandButton: TWinControl;
    procedure CalcDrawInfo(var DrawInfo: TGridDrawInfo); virtual;
    function HasFocus: boolean;  // Return true if we or a child of us has the focus;
    function IsActiveRowAlternatingColor: boolean;
    procedure CollapseChildGrid;
    procedure AddField(FieldName: string;
        Position: integer = -1; Redraw: boolean=True);
    procedure RemoveField(FieldName: string; Redraw: boolean = True);

    Function HaveAnyRowLines: boolean;
    {$ifdef wwdelphi4up}
    function ExecuteAction(Action: TBasicAction): Boolean; override; { 8/24/98 }
    function UpdateAction(Action: TBasicAction): Boolean; override; {8/24/98}
    {$endif}
    procedure GetURLLink(Value: string;
       var URLDisplayString: string; var URLLinkAddress: string); virtual;
    Procedure InvalidateCurrentRow;
    procedure InvalidateFooter;
    procedure FlushChanges; virtual;
    procedure UpdateRowCount;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override; {public to allow child to send keys to parent }
    Procedure SizeLastColumn;
    procedure BeginUpdate;
    procedure EndUpdate(Repaint: boolean = false);
    function IsCustomEditCell(col, row: integer; var customEdit: TWinControl) : boolean;
    function TitleCellRect(ACol, ARow: Longint): TRect; virtual;
    function GroupNameCellRect(ACol, ARow: Longint; var StartCol, EndCol: LongInt; VisibleOnly: boolean = True): TRect; virtual;
    function DragTitleCellRect(ACol, x, y: Longint): TRect; virtual;
    function CellRect(ACol, ARow: integer): TRect; virtual;
    procedure RestoreRowHeights;
    procedure ApplySelected; virtual;

    Procedure PaintActiveRowBackground(ACanvas: TCanvas; ARect: TRect);

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IsCheckBox(col,row: integer; var checkboxon, checkboxoff: string): boolean;
    Function IsMemoField(Acol, Arow: integer): boolean;
    Function IsSelected: boolean; dynamic;
    function AllowPerfectFit: boolean;
    Function DoPerfectFit: boolean;
    Function DoShrinkToFit: boolean;
    Procedure SelectRecord; virtual;
    Procedure UnselectRecord; virtual;
    Procedure SetPictureMask(FieldName: string; Mask: string);
    Procedure SetPictureAutoFill(FieldName: string; AutoFill: boolean);
    Procedure ClearLastBookmarks; { 5/2/00 - Add method to clear last bookmark values }
    Function FieldName(Acol: integer): string;
    Function GetHighlightColor: TColor;

    procedure DefaultDrawDataCell(const Rect: TRect; Field: TField; State: TGridDrawState);
    // 4/19/2001 - PYW - Moved so Exporting unit can call these events.
    procedure DoCalcTitleAttributes(AFieldName: string; AFont: TFont; ABrush: TBrush;
	     var FTitleAlignment: TAlignment); virtual;
    procedure DoCalcCellColors(Field: TField; State: TGridDrawState;
	     highlight: boolean; AFont: TFont; ABrush: TBrush); virtual;
    procedure DoCalcCellColorsDetect(Field: TField; State: TGridDrawState;
	     highlight: boolean; AFont: TFont; ABrush: TBrush); virtual;
    Function XIndicatorOffset: integer;
    Function GetComponent(thisName: string): TWinControl;

    function GetEffectiveFooterHeight: integer;

    // 7/5/01 - Inherited MouseCoord does not work for Bide mode with fixed-editable
    function MouseCoord(X, Y: Integer): TGridCoord;

    property DataLink: TwwGridDataLink read FDataLink;
    property RowHeights;
    property ColWidthsPixels[Index: Longint]: Integer read GetColWidthsPixels write SetColWidthsPixels;
    property EditorMode;
    property FieldCount: Integer read GetFieldCount;
    property Fields[Index: Integer]: TField read GetFields;
    property SelectedField: TField read GetSelectedField write SetSelectedField;
    property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
    property IndicatorColor: TIndicatorColorType read FIndicatorColor write SetIndicatorColor;
    property IndicatorIconColor: TColor read FIndicatorIconColor write SetIndicatorIconColor default clBlack;
    property Options: TwwDBGridOptions read FOptions write SetOptions
       default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
      dgRowLines,
      dgTabs, dgConfirmDelete, dgCancelOnExit,
      dgWordWrap{, dgVariableRowHeight}];
    property KeyOptions : TwwDBGridKeyOptions read FKeyOptions write FKeyOptions
       default [dgAllowInsert, dgAllowDelete];
    property TitleAlignment: TAlignment read FTitleAlignment write setTitleAlignment;
    property TitleLines : integer read FTitleLines write setTitleLines;
    property OnCalcCellColors: TCalcCellColorsEvent read FOnCalcCellColors write FOnCalcCellColors;
    property OnCalcTitleAttributes: TCalcTitleAttributesEvent read FOnCalcTitleAttributes write FOnCalcTitleAttributes;
    property OnDrawTitleCell: TwwDrawTitleCellEvent read FOnDrawTitleCell write FOnDrawTitleCell;
    property OnDrawGroupHeaderCell: TwwDrawGroupHeaderCellEvent read FOnDrawGroupHeaderCell write FOnDrawGroupHeaderCell;
    property OnCalcTitleImage: TwwCalcTitleImageEvent read FOnCalcTitleImage write FOnCalcTitleImage;
    property OnTitleButtonClick: TTitleButtonClickEvent read FOnTitleButtonClick write FOnTitleButtonClick;
    property RowHeightPercent : Integer read FRowHeightPercent write SetRowHeightPercent Default 100;
    property ShowVertScrollBar: boolean read FShowVertScrollBar write setShowVertScrollBar default True;
    property ShowHorzScrollBar: boolean read getShowHorzScrollBar write setShowHorzScrollBar;
    property OnCheckValue: TwwValidateEvent read FOnCheckValue write FOnCheckValue;
    property OnTopRowChanged: TNotifyEvent read FOnTopRowChanged write FOnTopRowChanged;
    property OnRowChanged: TNotifyEvent read FOnRowChanged write FOnRowChanged;
    property OnCellChanged: TNotifyEvent read FOnCellChanged write FOnCellChanged;
    property OnLeftColChanged: TwwLeftColChangedEvent read FOnLeftColChanged write FOnLeftColChanged;
    property OnFieldChanged: TwwFieldChangedEvent read FOnFieldChanged write FOnFieldChanged;
    property OnUpdateFooter: TNotifyEvent read FOnUpdateFooter write FOnUpdateFooter;
    property CalcCellRow: integer read GetCalcCellRow;  {onCalcCellColor Row}
    property CalcCellCol: integer read FCalcCellCol;  {onCalcCellColor Column}
    property TitleButtons: boolean read FTitleButtons write SetTitleButtons;
    property EditCalculated : boolean read FEditCalculated write FEditCalculated default False;
    property MultiSelectOptions: TwwMultiSelectOptions read FMultiSelectOptions write FMultiSelectOptions default [];
    property Selected : TStrings read getSelectedFields write setSelectedFields;
    property UseTFields: boolean read FUseTFields write SetUseTFields default True;
    property IndicatorButton: TwwIButton read FIndicatorButton write FIndicatorButton stored False;
    property ImageList: TImageList read FImageList write FImageList;
    property TitleImageList: TImageList read FTitleImageList write FTitleImageList;
    property LineColors: TwwGridLineColors read FLineColors write FLineColors;

    property Columns[Index: Integer]: TwwColumn read GetColumn; // write SetColumn;
    Function ColumnByName(Index: String): TwwColumn; // read GetColumnByName; // write SetColumn;
    property OnDrawFooterCell: TDrawFooterCellEvent read FOnDrawFooterCell write FOnDrawFooterCell;
    property OnCreateHintWindow : TwwCreateGridHintWindowEvent read FOnCreateHintWindow write FOnCreateHintWindow;
    property OnBeforePaint : TNotifyEvent read FOnBeforePaint write FOnBeforePaint;
    property OnURLOpen: TwwGridURLOpenEvent read FOnURLOpen write FOnURLOpen;
//    property OnValidationErrorUsingMask: TwwPictureValidationError read FOnValidationErrorUsingMask write FOnValidationErrorUsingMask;

    property Canvas : TCanvas read GetCanvas;
    property DragVertOffset: integer read FDragVertOffset write FDragVertOffset default 15;

    property ControlInfoInDataset: boolean
             read FControlInfoInDataset write FControlInfoInDataSet default True;
    property ControlType : TStrings read FControlType write SetControlType;
    property PictureMaskFromDataSet: boolean
             read FPictureMaskFromDataSet write FPictureMaskFromDataSet default True;
    property PictureMasks: TStrings read FPictureMasks write SetPictureMasks;
    property LeftCol;
    property PadColumnStyle: TwwPadColumnStyle read FPadColumnStyle write FPadColumnStyle default pcsPadHeaderAndData;
    property EditControlOptions: TwwEditControlOptions read FEditControlOptions write FEditControlOptions
             default [ecoSearchOwnerForm];
    property PaintOptions: TwwGridPaintOptions read FPaintOptions write FPaintOptions;//SetPaintOptions;
    property LineStyle: TwwGridLineStyle read FLineStyle write FLineStyle default glsDynamic;
    property HideAllLines: boolean read FHideAllLines write FHideAllLines default False;
  end;

   TwwUpdateSelected=(sptUpdateField, sptUpdateWidth, sptUpdateLabel, sptUpdateReadOnly,
      sptUpdateGroup);

procedure UpdateSelectedProp(Selected: TStrings;
   FieldName: string; val: string;
   SelectedProperty: TwwUpdateSelected; Index: integer = -1);

function GetSelectedProp(Selected: TStrings;
   FieldName: string;
   SelectedProperty: TwwUpdateSelected): string;

Procedure wwWriteTextLines(ACanvas: TCanvas;
    const ARect: TRect; DX, DY: Integer; S: PChar; Alignment: TAlignment;
    WriteOptions: TwwWriteTextOptions);


implementation

uses DBConsts,
  {$ifdef wwDelphi6Up}
  VDBConsts,
  {$endif}
  Consts, Dialogs, wwcommon, wwpict, wwintl, wwdbgrid, math,
bde, wwcheckbox, shellapi, wwdatainspector;

{$IFDEF WIN32}
{$R WWDBI32.RES}
{$ELSE}
{$R WWDBIGRD.RES}
{$ENDIF}

const
  bmArrow = 'WWDBGARROW';
  bmEdit = 'WWDBEDIT';
  bmInsert = 'WWDBINSERT';
  bmMultiSelect = 'WWDBMULTISELECT';
  bmMultiArrow = 'WWDBMULTIARROW';
  bmArrowYellow = 'WWDBGARROWYELLOW';
  bmEditYellow = 'WWDBEDITYELLOW';
  bmInsertYellow = 'WWDBINSERTYELLOW';
  bmMultiSelectYellow = 'WWDBMULTISELECTYELLOW';
  bmMultiArrowYellow = 'WWDBMULTIARROWYELLOW';

  MaxMapSize = 65520 div SizeOf(Integer);
//  GridScrollSize = 200;

  NormalPad = 2;

  ctmdNone = 0;
  ctmdForward = 1;
  ctmdBackward = 2;

var
    DragImages: TImageList;
    Indicators: TImageList;
    UserCount: Integer;

procedure InitIndicators;
var Bmp: TBitmap;
begin
  Indicators.Free;
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromResourceName(HInstance, bmArrow);
//    ChangeColorBitmap(Bmp, IndicatorIconColor, clBlack);
    Indicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
    Indicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmEdit);
//    ChangeColorBitmap(Bmp, IndicatorIconColor, clBlack);
    Indicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmInsert);
//    ChangeColorBitmap(Bmp, IndicatorIconColor, clBlack);
    Indicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmMultiSelect);
//    ChangeColorBitmap(Bmp, IndicatorIconColor, clBlack);
    Indicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmMultiArrow);
//    ChangeColorBitmap(Bmp, IndicatorIconColor, clBlack);
    Indicators.AddMasked(Bmp, clWhite);
//    Indicators.BkColor:= clWhite;
  finally
    Bmp.Free;
  end;

end;

procedure UsesBitmap;
var Bmp: TBitmap;
begin
  if UserCount = 0 then
  begin
    InitIndicators;
    Bmp := TBitmap.Create;
    try
      Bmp.LoadFromResourceName(HInstance, 'WWRIGHT');
      DragImages := TImageList.CreateSize(Bmp.Width, Bmp.Height);
      DragImages.AddMasked(Bmp, clWhite);
      Bmp.LoadFromResourceName(HInstance, 'WWLEFT');
      DragImages.AddMasked(Bmp, clWhite);
      DragImages.BkColor:= clWhite;
    finally
      Bmp.Free;
    end;
  end;
  Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
  Dec(UserCount);
  if UserCount = 0 then begin
     Indicators.Free;
     Indicators:=nil;
     DragImages.Free;
     DragImages:=nil;
  end;
end;

//var
//  BrowseIndicatorBitmap, EditIndicatorBitmap,
//  InsertIndicatorBitmap, MultiSelectBitmap, MultiArrowBitmap: TBitmap;

{type
  TwwGridHintWindow=class(THintWindow)
  private
     Field: TField;
     WordWrap: boolean;
  protected
     procedure Paint; override;
  public
     HintText: string;
  end;
}
var KeyHook : HHOOK;

function wwHookKeyProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
type
  TSelection = record
    StartPos, EndPos: Integer;
  end;
var ac: TWinControl;
    Grid: TwwCustomDBGrid;

    Function IsImmediateChildOfGrid: boolean;
    var tc: TWinControl;
    begin
       tc:= screen.activecontrol;
       result:=  tc.parent is TCustomGrid;
    end;

    Function GetwwDBgrid(var Grid: TwwCustomDBGrid): boolean;
    var tc: TWinControl;