wwdbigrd.pas

胜天进销存源码,国产优秀的进销存

    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;
    property FastColumns[Index: Integer]: TwwColumn read GetFastColumn; // 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 RegexMasks: TStrings read FRegexMasks write SetRegexMasks;
    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;
    property OnBeforeDrawCell: TwwCustomDrawCellEvent read FOnBeforeDrawCell write FOnBeforeDrawCell;
    property OnAfterDrawCell: TwwCustomDrawCellEvent read FOnAfterDrawCell write FOnAfterDrawCell;
    property OnDitto: TwwDittoEvent read FOnDitto write FOnDitto;
    property VisibleRowCount;
    property DittoAttributes : TwwDittoAttributes read FDittoAttributes write FDittoAttributes;
    property DisableThemesInTitle: boolean read FDisableThemesInTitle write FDisableThemesInTitle default false;
  protected
    procedure GridUpdateData; virtual;
    Procedure WriteTextLines(ACanvas: TCanvas;
      const ARect: TRect; DX, DY: Integer; S: PWideChar; Alignment: TAlignment;
       WriteOptions: TwwWriteTextOptions); virtual;

    procedure DoOnAfterDrawCell(var DrawCellInfo: TwwCustomDrawGridCellInfo); virtual;
    procedure DoOnBeforeDrawCell(ATextWide: WideString; var DrawCellInfo: TwwCustomDrawGridCellInfo); virtual;
    function WideGetFieldValue(ACol: Integer): Widestring; dynamic;
  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);

function wwGetIndicators: TImageList;

implementation

uses DBConsts,
  {$ifdef wwDelphi6Up}
  VDBConsts,
  {$endif}
  Consts, Dialogs, wwcommon, wwpict, wwintl, wwdbgrid, math,
  {$ifdef wwDelphi7Up}
  themes,
  {$endif}
  {$ifdef ThemeManager}
  thememgr, themesrv, uxtheme,
  {$endif}
bde, wwcheckbox, shellapi, imglist, imm;

{$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;
  wwDisableDrawBottomLine = 1;
  wwDisableDrawHorzTopLine = 2;

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

function wwGetIndicators: TImageList;
begin
  result:= Indicators;
end;

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;  // 8/20/04 - Need to set BkColor for XP Service Pack 2 and Windows 2003
  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;
}

// Return next tabbed control
function FindNextControl(CurControl: TWinControl;
  GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
var
  I, StartIndex: Integer;
  List: TList;
begin
  Result := nil;
  List := TList.Create;
  try with curControl.parent do begin
    GetTabOrderList(List);
    if List.Count > 0 then
    begin
      StartIndex := List.IndexOf(CurControl);
      if StartIndex = -1 then
        if GoForward then StartIndex := List.Count - 1 else StartIndex := 0;
      I := StartIndex;
      repeat
        if GoForward then
        begin
          Inc(I);
          if I = List.Count then begin
//             I := 0;
             result:= nil;
             exit;
          end
        end else
        begin
          if I = 0 then begin
//             I := List.Count;
             result:= nil;
             exit;
          end;
          Dec(I);
        end;
        CurControl := List[I];
        if CurControl.CanFocus and
          (not CheckTabStop or CurControl.TabStop) and
          (not CheckParent or (CurControl.Parent = CurControl.parent)) then
          Result := CurControl;
      until (Result <> nil) or (I = StartIndex);
    end;
    end
  finally
    List.Free;
  end;
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;
    KeyMsg: //TWMKey;
            TWMKeyDown;
    nextctl: TWinControl;

    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;
    begin
       tc:= screen.activecontrol;

       // 6/1/06 - Make sure assigned
       if not Assigned( tc ) then
       begin
         Grid := nil;
         result := false;
         exit;
       end;

       if not (tc is TwwCustomDBGrid) then
       begin
          repeat
             tc:= tc.parent;
          until (tc=nil) or (tc is TwwCustomDBGrid);
       end;
       result:=  (tc is TwwCustomDBGrid);
       if result then
          Grid:= TwwCustomDBGrid(tc)
       else