wwcommon.pas

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

unit wwcommon;
{$T-}  { Disable Typed@ Operator}
{
//
// Components : Common routines
//
// Copyright (c) 1995, 1996, 1997, 1998 by Woll2Woll Software
//
//  7/24/97 - Linked field filter did not work when using multiple lookuptables
//
//  8/14/97 - Optimized logic to speed painting of grid
//            in wwDataSet_GetControl method
//
// 10/16/97 - Skip descending test if using IndexFieldNames
//
// 11/14/97 - Have wwSetLookupField work for virtual datasets
//
// 2/24/98 - Subtrack length(key) when padding NarrowSearchUpperChar
//
// 3/02/98 - Don't specify extension when opening picture-mask table
//
// 3/31/98 - Determine if this is a single line edit control based on passed in rectangle
//
// 9/13/98 - Changed handle to HDC in wwIsSingleLineEdit
// 9/16/98 - WordBool is 2 bytes
// 11/7/98 - Add support for filtering on lookupfields in clientdatasets
//           from the filterdialog.
// 11/21/99 - Support BCD for creating tparam
// 2/8/2000 - SetSQLProp now passes propertyname
// 6/11/2001 - Added vertical alignment support for single line edit - PYW.
// 2/14/2002 - Added wwCopyToClipboard function. -PYW
// 4/10/2002 - Save and Restore Text Color. -PYW
// 6/23/03 - Check for null lookup value
// 7/18/03 - Multi-field search skips - Fixed bug
}
interface

uses classes, db, sysutils, dialogs, wwstr, dbTables, forms, controls,
     windows, graphics, buttons, wwtypes, wwlocate, wwstorep,
     stdctrls, comctrls,

{$i wwIfDef.pas}

{$IFDEF WIN32}
bde, registry
{$ELSE}
dbiprocs, dbiTypes, dbierrs
{$ENDIF}
;

const
   WW_DB_COMBO = 'Combo';
   WW_DB_LOOKUP_COMBO = 'LookupCombo';  { Backward compatibility with Infopower 1.2}
   WW_DB_EDIT = 'CustomEdit';
   WW_DB_RICHEDIT = 'RichEdit';


type
{$ifdef win32}
  wwSmallString = string;
{$else}
  wwSmallString = string[64];
{$endif}

Function wwGetControlList(Controller: TComponent): TList;
procedure wwUpdateController(
   var FController: TComponent;
   Value: TComponent;
   Control: TComponent);

function wwGetEventShift(Shift: TShiftState): Integer;
procedure wwClearControls(Component: TComponent);
function wwHaveVisibleChild(ac: TWinControl): boolean;  // i.e. Combo dropped down
function wwIsDesigning(control: TControl): boolean;
Function wwGetPictureControl(Control: TComponent; DataSet: TDataSet = nil): TComponent;
Function wwGetPictureMasks(DataSet: TComponent): TStrings;
Procedure wwRegexByField(DataSet: TComponent; FieldName: string;
    var Mask: string; var CaseSensitive: boolean; var ErrorMsg: string);
Function wwGetRegexMasks(DataSet: TComponent): TStrings;
procedure wwSetRegexMasks(dataSet: TComponent; AFieldName: string;
    AMask: string;
    CaseSensitive: boolean;
    ErrorMsg: string);
Function wwGetStrings(Component: TComponent; PropertyName: string): TStrings;
Function wwGetControlType(dataSet: TComponent): TStrings;
Function wwGetValidateWithMask(dataSet: TDataSet): boolean;
Function wwGetControlTypeControl(Control: TComponent; DataSet: TDataSet = nil): TComponent;
Function wwGetControlInfoInDataSet(component: TComponent): boolean;
Function wwGetPictureMaskFromDataSet(Component: TComponent): boolean;
Function wwGetLookupFields(dataSet: TDataSet): TStrings;
Function wwGetLookupLinks(dataSet: TDataSet): TStrings;
Function wwGetDatabaseName(dataSet: TDataSet): String;
Function wwGetConnectionString(dataSet: TDataSet): String;
Function wwGetConnection(dataSet: TDataSet): TComponent;
Function wwGetTableName(dataSet: TDataSet): String;
Function wwDataSetIsValidField(dataset : TComponent; fieldName : string): boolean;
Procedure wwDataSetUpdateFieldProperties(dataSet: TDataSet; selected: TStrings);
Procedure wwDataSetUpdateSelected(dataSet: TDataSet; selected: TStrings);
Function wwDataSet(dataSet : TDataSet): boolean;
Procedure wwDebug(s: string);
Function wwSetLookupField(dataSet: TDataSet; linkedField: TField): boolean;
procedure wwDataSetDoOnCalcFields(dataSet: TDataSet;
          FLookupFields, FLookupLinks: TStrings;
          lookupTables: TList);
procedure wwDataSetRemoveObsolete(dataSet: TComponent;
          FLookupFields, FLookupLinks, FControlType: TStrings);
Function wwTableFindNearest(dataSet: TDataSet; key: string; FieldNo: integer): boolean;
procedure wwTableChangeIndex(dataSet: TDataSet; a_indexItem: TIndexDef);
Function wwDataSetGetLinks(dataSet: TDataSet; lookupFieldName: string): string;
Function wwDataSetGetDisplayField(dataSet: TDataSet; lookupFieldName: string): string;
Function wwDataSetSyncLookupTable(dataSet: TDataSet; AlookupTable: TDataSet;
                  lookupFieldName: string; var fromField: string): boolean;
//Function wwDataSetRemoveObsoleteControls(parentForm: TCustomForm; dataSet: TComponent): boolean;

procedure wwDataSet_SetControl(dataSet: TComponent;
          AFieldName: string; AComponentType: string; AParameters: string);
function wwFieldIsValidValue(fld: TField; key: string): boolean;
Function wwIsValidValue(FldType: TFieldType; key: string):boolean;
Function wwFieldIsValidLocateValue(fld: TField; key: string):boolean;
Function wwGetAlias(aliasName: string): string;
Function wwSaveAnswerTable(ADataSet: TDBDataSet; AHandle: HDbiCur; tableName: string): boolean;
Function wwInPaintCopyState(ControlState: TControlState): boolean;
Function wwDataSetLookupDisplayField(
   curField: TField; var LookupValue: string; var DisplayField: TField): boolean;
procedure wwPlayKeystroke(Handle: HWND; VKChar: word; VKShift: Word);
procedure wwDataSet_GetControl(dataSet: TComponent; AFieldName: string;
                      var AControlType: string; var AParameters: string);
function wwGetQueryText(tempQBE: TStrings; Sql: boolean): PChar;
Function wwMemAvail(memSize: integer): boolean;
Procedure wwPictureByField(DataSet: TComponent; FieldName: string; FromTable: boolean;
    var Mask: string; var AutoFill, UsePictureMask: boolean);
procedure wwSetPictureMask(dataSet: TComponent; AFieldName: string;
    AMask: string;
    AutoFill: boolean;
    UsePictureMask: boolean;
    SetMask: boolean;
    SetAutoFill: boolean;
    SetUsePictureMask: boolean);
Function wwGetFieldNameFromTitle(DataSet: TDataSet; fieldTitle: string): string;
Function wwGetListIndex(list: TStrings; itemName: string): integer;
Function wwGetOwnerForm(component: TComponent):TCustomForm;
Function wwGetOwnerFrameOrForm(component: TComponent):TComponent;
procedure wwClearAltChar;
Function isWWEditControl(pname: string): boolean;
procedure wwDataModuleChanged(temp: TComponent);
Function wwDoLookupTable(ALookupTable : TTable;  DataSet: TDataset; links: TStrings) : boolean;
{$ifdef win32}
Procedure wwDrawGlyph(
    Bitmap: TBitmap;
    Canvas: TCanvas; R: TRect;
    State: TButtonState;
    Enabled: Boolean;
    Transparent: boolean;
    FlatButtonTransparent: boolean;
    ControlState: TControlState);
    
Procedure wwDrawEllipsis(Canvas: TCanvas; R: TRect;
    State: TButtonState;
    Enabled: Boolean;
    Transparent: boolean;
    FlatButtonTransparent: boolean;
    ControlState: TControlState);
Procedure wwDrawDropDownArrow(Canvas: TCanvas; R: TRect;
    State: TButtonState;
    Enabled: Boolean;
    ControlState: TControlState);
{$endif}
Function wwHasIndex(ADataSet: TDataSet): boolean;
Function wwIsTableQuery(ADataSet: TDataSet): boolean;
Function wwPdxPictureMask(ADataSet: TDataSet; AFieldName: string): string;
procedure wwFixMouseDown;
procedure wwValidatePictureFields(ADataSet: TDataSet;
     FOnInvalidValue: TwwInvalidValueEvent);
function wwDataSetFindRecord(
   DataSet: TDataSet;
   KeyValue: string;
   LookupField: string;
   MatchType: TwwLocateMatchType;
   caseSensitive: boolean): boolean;
//Procedure wwOpenPictureDB(wwtable: TTable);
Function wwValidFilterableFieldType(ADataType: TFieldType): boolean;
procedure wwALinkHelp(Handle: HWND; ALink: string);
procedure wwHelp(Handle: HWND; HelpTopic: PChar);
Function wwIsValidChar(key: word): boolean;
Function wwGetOnInvalidValue(DataSet: TDataSet): TwwInvalidValueEvent;
Function wwGetCalcCellColorsEvent(Grid: TWinControl): TMethod;
Function wwGetOnPerformCustomSearch(Component: TComponent): TwwPerformSearchEvent;

procedure wwDataSet_SetLookupLink(dataSet: TDataSet;
   FldName, DatabaseName, TableName, DisplayFld, IndexFieldNames, Links: string;
   useExtension: Char);
Function wwFindSelected(selected: TStrings;
   FieldName: string; var index: integer): boolean;
Function wwAdjustPixels(PixelSize,PixelsPerInch : integer): integer;
Function wwProcessEscapeFilterEvent(dataset: TDataset): boolean;
Procedure wwSetOnFilterEnabled(dataset: TDataset; val: boolean);
Function wwGetOnFilterOptions(dataset: TDataset): TwwOnFilterOptions;
Function wwmin(x,y: integer): integer;  {4/10/97}
Function wwlimit(val, x,y: integer): integer;  {4/10/97}
Function wwmax(x,y: integer): integer;  {4/10/97}
Function wwDataSet_GetFilterLookupField(dataSet: TDataSet; curfield: TField; AMethod: TMethod): TField;
Procedure wwConvertFieldToParam(OtherField:TField;var AFilterParam:TParam;AFilterFieldBuffer: PChar);
Function wwisNonBDEField(thisField: TField): boolean;
Function wwisNonPhysicalField(thisField: TField): boolean;
Function wwSetControlDataSource(ctrl: TControl; ds: TDataSource): boolean;
Function wwSetControlDataSet(ctrl: TComponent; DataSet: TDataSet; PropertyName: string): boolean;
Function wwSetControlDataField(ctrl: TControl; df: string): boolean;
Function wwGetControlDataField(ctrl: TControl): string;
Function wwGetControlDataSource(ctrl: TComponent): TDataSource;
Function wwGetControlMasterSource(ctrl: TComponent): TDataSource;
Function wwSetDatabaseName(ctrl: TDataset; df: string): boolean;
Function wwSetSessionName(ctrl: TDataset; df: string): boolean;
Function wwSetString(ctrl: TComponent; PropertyName : string; s: string): boolean;
Function wwSetConnectionString(ctrl: TDataset; df: string): boolean;
Function wwSetConnection(ctrl: TDataset; Connection: TComponent): boolean;
Function wwGetSessionName(dataSet: TDataSet): String;
function wwDataSetCompareBookmarks(DataSet: TDataSet; Bookmark1, Bookmark2: TBookmark): CmpBkmkRslt;
function wwIsClass(ClassType: TClass; const Name: string): Boolean;
function wwGetWorkingRect:TRect;
Function wwApplyPictureMask(Control: TCustomEdit; PictureMask: string; AutoFill: boolean; var Key: Char): boolean;
Function wwValidPictureValue(Control: TCustomEdit; PictureMask: string): boolean;
Function wwGetSQLWord(s: string; var APos: integer): string;
Function wwSetSQLProp(ctrl: TDataset; sql: TStrings; PropName: string): boolean;
Function wwSetParamsProp(ctrl: TDataset; Params: TParams): boolean;
Function wwGetParamsProp(ctrl: TDataset): TParams;
Function wwGetAlwaysTransparent(ctrl:  TControl): boolean;
Function wwSetBoolean(ctrl: TComponent; PropertyName: string; val: boolean): boolean;
Function wwSetRequestLive(ctrl: TDataset; val: boolean): boolean;
Function wwGetParamCheck(ctrl: TDataset): boolean;
Function wwGetBorder(ctrl: TControl): boolean;
Function wwSetBorder(ctrl: TControl; val: boolean): boolean;

Function wwGetWantReturns(ctrl: TControl): boolean;
Function wwSetReadOnly(ctrl: TControl; val: boolean): boolean;
Function wwSetParamCheck(ctrl: TDataset; val: boolean): boolean;
Function wwGetIBDatabase(dataSet: TDataSet): TComponent;
Function wwSetIBDatabase(Dataset: TDataSet; db: TComponent): boolean;

{ 9/13/98 - Changed handle to HDC }
Function wwIsSingleLineEdit(AHandle:HDC; Rect: TRect; Flags:Integer): boolean;
{Procedure wwCopyDatasetProp(dataset1, dataset2: TDataset);}

Function wwGetControlPictureMask(ctrl: TCustomEdit): String;
Procedure wwSetControlPictureMask(ctrl: TCustomEdit; PictureMask: string);
Function wwGetControlAutoFill(ctrl: TCustomEdit): boolean;
Procedure wwSetControlAutoFill(ctrl: TCustomEdit; AutoFill: boolean);

function wwCallbackMemoRead(DataSet: TBDEDataSet;
                   FFilterBuffer: Pointer;
                   var Buffer;
                   curField: TField;
                   Count: Longint): Longint;

procedure RichEditTextToPlainText(
      Owner: TWinControl;
      MemoBuffer: PChar;
      var numRead: Cardinal;
      var RichEditControl: TRichEdit;
      var MemoryStream: TMemoryStream);
function wwIsRichEditField(Field: TField; ExamineData: boolean): boolean;

//procedure wwGetInterface(AObject: TObject; IID: TGUID; out Obj);
procedure wwDrawFocusRect(ACanvas: TCanvas; ARect: TRect);
{$ifdef wwDelphi4Up}
function UpdatedVCL4Version: boolean;
{$endif}
function wwIsCustomEditCell(
        Component: TComponent;
        ownerForm: TComponent;
        curField: TField;
        var customEdit: TWinControl) : boolean;
function IsInGridPaint(dtp:TWinControl):boolean;
function IsInGrid(dtp:TWinControl):boolean;

function IsInwwGridPaint(control: TWinControl):boolean;
function IsInwwObjectView(control: TWinControl):boolean;
function IsInwwObjectViewPaint(control: TWinControl):boolean;
procedure wwDottedLine(Canvas: TCanvas; p1, p2: TPoint);
procedure wwSetTableIndex(DataSet: TDataSet; FieldName: string);
Procedure wwWriteTextLinesT(ACanvas: TCanvas;
    const ARect: TRect; DX, DY: Integer; S: PChar; Alignment: TAlignment;
    WriteOptions: TwwWriteTextOptions);
function wwRectWidth(Rect: TRect): Integer;
function wwRectHeight(Rect: TRect): Integer;
procedure wwDisableParentClipping(Parent: TWinControl);
function wwSetDatabaseCursorType(DataSet: TDataSet; val: integer): boolean;
function wwGetDatabaseCursorType(DataSet: TDataSet): integer;
function wwGetCommandType(DataSet: TDataSet): integer;
function wwSetDatabaseMaxRecords(DataSet: TDataSet; val: integer): boolean;
//procedure wwAdjustHeight(Control: TWinControl);
procedure wwcopyToClipBoard(const str: string; const htmlStr: string = '');
function wwGetOrdProp(Component: TPersistent; PropName: string): Integer;
Function wwGetEditCalculated(ctrl: TControl): boolean;
function wwUseThemes(Control: TControl): boolean;
Function wwGetDataSet(DataSet: TComponent): TDataSet;
function IsVistaComCtrlVersion: boolean;
function IsVista: boolean;

//function RegexMatchDll(pattern: LPCSTR; icasePattern: BOOL; input: LPCSTR): integer; stdcall;
//function RegexMatchDll; external 'wwRegEx.dll' name 'RegexMatch';
//function RegexSyntaxValidDll(pattern: LPCSTR): BOOL; stdcall;
//function RegexSyntaxValidDll; external 'wwRegEx.dll' name 'RegexSyntaxValid';
function RegexMatch(pattern: string; icasePattern: boolean; input: string): boolean;
function RegexSyntaxValid(pattern: string): boolean;

procedure wwFillEditThemeBackground(
   IsDroppedDown: boolean; MouseInControl: boolean; ARect: TRect; FCanvas: TCanvas);


implementation

uses wwTable, wwQuery, wwQBE, wwsystem, Messages, wwpict, wwintl, typinfo,
{$ifdef wwDelphi6Up}
fmtbcd, variants,
{$endif}
{$ifdef wwDelphi7Up}
themes,
{$endif}
{$ifdef ThemeManager}
thememgr, themesrv, uxtheme,
{$endif}
     wwdbedit;

type
TwwRegexMatch =
  function (pattern: LPCSTR; icasePattern: BOOL; input: LPCSTR): integer; stdcall;
TwwRegexSyntaxValid = function (pattern: LPCSTR): BOOL; stdcall;

var inLookupCalcLink : boolean;   {Internal Use Only}

  regexMatchProc: TwwRegexMatch;
  regexSyntaxValidProc: TwwRegexSyntaxValid;
  FLibRegexHandle: THandle;
  MessageShown: boolean;

{ 5/12/97 - Use generic way to retrieve propery }
Function wwGetOnInvalidValue(DataSet: TDataSet): TwwInvalidValueEvent;
var PropInfo: PPropInfo;
    method: TMethod;
begin
   Result:= Nil;
   PropInfo:= Typinfo.GetPropInfo(DataSet.ClassInfo,'OnInvalidValue');
   if PropInfo<>Nil then begin
      method:= GetMethodProp(DataSet, PropInfo);
      if method.code<>Nil then
         result:= TwwInvalidValueEvent(method);
   end
end;

Function wwGetOnPerformCustomSearch(Component: TComponent): TwwPerformSearchEvent;
var PropInfo: PPropInfo;
    method: TMethod;
begin
   result:= nil;
   PropInfo:= Typinfo.GetPropInfo(Component.ClassInfo,'OnPerformCustomSearch');
   if PropInfo<>Nil then begin
      method:= GetMethodProp(Component, PropInfo);
      if method.code<>Nil then
         result:= TwwPerformSearchEvent(method);
   end
end;

{ 5/12/97 - Use generic way to retrieve propery }
Function wwGetCalcCellColorsEvent(Grid: TWinControl): TMethod;
var PropInfo: PPropInfo;
    method: TMethod;
begin
   method.code:= nil;
   method.Data:= nil;
   PropInfo:= Typinfo.GetPropInfo(Grid.ClassInfo,'OnCalcCellColors');
   if PropInfo<>Nil then begin
      method:= GetMethodProp(Grid, PropInfo);
      result:= method;
   end
end;

Function wwGetPictureControl(Control: TComponent; DataSet: TDataSet = nil): TComponent;
var ds: TDataSource;