flexutils.int

FlexGraphics是一套创建矢量图形的VCL组件

   function  GetPropertyType(const PropValue: Variant): integer;
   property  Process: TFlexFilerProcess read FProcess;
   property  KeyDontStore: TFlexBinKeyStoreSet read FKeyDontStore write
     FKeyDontStore;
   property  Finished: boolean read FFinished;
   property  DicCapacity: integer read FDicCapacity write SetDicCapacity;
   property  DicDeleteCount: integer read FDicDeleteCount
     write SetDicDeleteCount;
   property  ReadCmdCommand: word read FCmdReadHeader.Command;
   property  ReadCmdSize: integer read FCmdReadHeader.Size;
   property  ReadCmdDataSize: integer read FCmdReadDataSize;
   property  ReadCmdKeyCount: word read FCmdReadHeader.KeyCount;
   property  ReadCmdKeys[Index: integer]: string read GetReadKey;
   property  ReadCmdKeysSize: integer read FCmdKeysSize;
  end;

  TFlexProgressEvent = procedure(Sender: TObject; Progress: integer;
    Process: TFlexFilerProcess) of object;

  TFlexFiler = class
  private
   FStream: TStream;
   FBuffer: Pointer;
   FBufSize: Integer;
   FBufPos: Integer;
   FBufEnd: Integer;
   FTotal: integer;
   FSaved: integer;
   FLoaded: integer;
   FProgress: integer;
   FLastProcess: TFlexFilerProcess;
   FBinary: boolean;
   FCompleteBinary: boolean;
   FBinaryData: TFlexBinaryData;
   FOnProgress: TFlexProgressEvent;
   procedure SetSaved(const Value: integer);
   procedure SetTotal(const Value: integer);
   procedure SetBinary(const Value: boolean);
  protected
   procedure ReadBuffer;
   procedure DoProgress(Process: TFlexFilerProcess);
   function  GetStreamSize: integer;
   function  ReadBufCheck(Buf: pointer; BufSize: integer): boolean;
   procedure ReadBuf(var Buf; BufSize: integer);
   function  ReadSkipBuf(BufSize: integer): boolean;
   procedure WriteBuf(const Buf; BufSize: integer);
   procedure ReadError(const Msg: string = ''); virtual;
   procedure WriteError(const Msg: string = ''); virtual;
   property  Stream: TStream read FStream;
  public
   constructor Create(AStream: TStream; ACompleteBinary: boolean = false);
   destructor Destroy; override;
   procedure SaveStr(const s: string);
   procedure SaveBuf(Buf: pointer; BufSize: integer);
   function  LoadStr: string;
   function  LoadStrCheck(out s: string): boolean;
   procedure LoadSkipToEnd;
   function  CheckLoadSkipToEnd(const First: string): boolean;
   function  IsEndOfStream: boolean;
   procedure Rewind;
   property  Binary: boolean read FBinary write SetBinary;
   property  CompleteBinary: boolean read FCompleteBinary;
   property  BinaryData: TFlexBinaryData read FBinaryData;
   property  Total: integer read FTotal write SetTotal;
   property  Saved: integer read FSaved write SetSaved;
   property  Loaded: integer read FLoaded;
   property  StreamSize: integer read GetStreamSize;
   property  Progress: integer read FProgress;
   property  OnProgress: TFlexProgressEvent read FOnProgress write FOnProgress;
  end;

  TIdPool = class
  private
   FPool: TList;
   function  GetUsed(Value: cardinal): boolean;
  public
   constructor Create;
   destructor Destroy; override;
   function  Generate: cardinal;
   function  Use(Value: cardinal): boolean;
   function  Release(Value: cardinal): boolean;
   function  NextUsed(Value: cardinal; var Index: integer): cardinal;
   procedure Clear;
   property  Used[Value: cardinal]: boolean read GetUsed;
   property  PoolList: TList read FPool;
  end;

  TNotifyLink = class;

  TNotifyLinkCode = ( ncInfo, ncDestroy, ncPropBeforeChanged, ncPropChanged,
    ncControlNotify );

  PNotifyLinkInfo = ^TNotifyLinkInfo;
  TNotifyLinkInfo = record
   case Code: TNotifyLinkCode of
    ncInfo:
      ( WParam: integer;
        LParam: integer ); // Generic notification
    ncDestroy: ();
    ncPropBeforeChanged,
    ncPropChanged:
      ( Prop: TObject {TCustomProp} );
    ncControlNotify:
      ( Control: TObject {TFlexControl};
        ControlNotify: TFlexNotify );
  end;

  TNotifyLinkEvent = procedure(Sender: TObject; Source: TNotifyLink;
    const Info: TNotifyLinkInfo) of object;

  TNotifyLink = class
  private
   FLinks: TList;
   FOwner: TObject;
   FTag: integer;
   FDestroying: boolean;
   FOnNotify: TNotifyLinkEvent;
   FOnFreeNotify: TNotifyLinkEvent;
   function  GetLink(Index: integer): TNotifyLink;
   function  GetLinkCount: integer;
   function  GetLinkRefCount(Index: integer): integer;
  public
   constructor Create(AOwner: TObject);
   destructor Destroy; override;
   function  IndexOf(Link: TNotifyLink): integer;
   function  Subscribe(Link: TNotifyLink): integer;
   function  Unsubscribe(Link: TNotifyLink): integer;
   function  Notify(const Info: TNotifyLinkInfo): integer;
   procedure DestroyNotify;
   function  PropNotify(AProp: TObject; IsBeforeNotify: boolean): integer;
   function  ControlNotify(AControl: TObject; ANotify: TFlexNotify): integer;
   property  Owner: TObject read FOwner;
   property  LinkCount: integer read GetLinkCount;
   property  Links[Index: integer]: TNotifyLink read GetLink; default;
   property  LinksRefCount[Index: integer]: integer read GetLinkRefCount;
   property  Tag: integer read FTag write FTag;
   property  Destroying: boolean read FDestroying;
   property  OnNotify: TNotifyLinkEvent read FOnNotify write FOnNotify;
   property  OnFreeNotify: TNotifyLinkEvent read FOnFreeNotify
     write FOnFreeNotify;
  end;

var
  SysGradientChecked: boolean = false;
  SysGradientEnabled: boolean = false;
  SysGradientEllipticSteps: integer = 256;

procedure LoadFlexCursors;

function  FlexStrNeedQuote(const s: string): boolean;
function  StrBeginsFrom(const S1, S2: string): boolean;
function  ExtractWord(const s: string; NumWord: integer; Delimiter: char): string;
function  HexCharsToByte(cw: word): byte;
function  ByteToHexChars(b: byte): word;

procedure GetPicReadWrite(Picture: TPicture;
  out ReadProc, WriteProc: TStreamProc);
function  NormalizeRect(const R: TRect): TRect;
function  PointInRect(const p: TPoint; const R: TRect): boolean;

function  IntersectClipRgn(ACanvas: TCanvas; ClipRgn: HRGN): HRGN;
function  IntersectClipPath(DC: HDC): HRGN;
procedure PaintGradient(ACanvas: TCanvas; ARect: TRect; Style: TGradientStyle;
  Color, EndColor: TColor; PenMode: TPenMode);
procedure PaintBitmap(ACanvas: TCanvas; const PaintRect, RefreshRect: TRect;
  ABitmap: TBitmap; BitmapDisplay: TBitmapDisplay;
  BitmapCache: PTiledBitmapCache = Nil; Scale: integer = 100;
  ClipTransparent: boolean = false);
procedure PaintTailed(ACanvas: TCanvas; const PaintRect, RefreshRect: TRect;
  ABitmap: TBitmap; BitmapCache: PTiledBitmapCache = Nil);

function  CreateTransparentClipRgn(DC: HDC; Width, Height: integer;
  var Dest: TRect; TransparentColor: TColor): HRGN;
procedure ExcludeBitmapTransparency(Bmp: TBitmap; var R: TRect;
  var ClipRgn: HRGN);

function  ScaleValue(Value, Scale: integer): integer;
function  UnScaleValue(Value, Scale: integer): integer;
function  ScalePixels(Value: integer): integer;
function  UnScalePixels(Value: integer): integer;

function  ListScan(Value, List: Pointer; Count: integer): integer;
function  ListScanEx(Value, List: Pointer; Index, Count: integer): integer;
function  ListScanLess(Value, List: Pointer; Count: integer): integer;

type
  TSortedListCompare = function(Item1, Item2: Pointer): Integer of object;

// Find Item index in alredy sorted list
function  SortedListFind(List: PPointerList; Count: integer; Item: Pointer;
  Compare: TSortedListCompare; Exact: boolean): integer;
// Return new index for item with ItemIndex in already sorted list. This
// function must be called after some changes in the item to keep list sorted.
// Caller must move item at ItemIndex to resulting index after call.
function  ListSortItem(List: PPointerList; Count: integer; ItemIndex: integer;
  Compare: TSortedListCompare): integer;
// Sort List in order defined by Compare method
procedure ListQuickSort(List: PPointerList; L, R: Integer;
  Compare: TSortedListCompare);

function  IsClassParent(AClass, AParentClass: TClass): boolean;

function  DotFloatToStr(const Value: extended): string;
function  DotStrToFloat(Value: string): extended;

{$IFNDEF FG_D5}
procedure FreeAndNil(var Obj);

function GetPropValue(Instance: TObject; const PropName: string;
  PreferStrings: Boolean): Variant;
procedure SetPropValue(Instance: TObject; const PropName: string;
  const Value: Variant);
function PropType(AClass: TClass; const PropName: string): TTypeKind;
{$ENDIF}

{$IFNDEF FG_D6}
{ Copied from Delphi7 System.pas unit }

const
  varByte     = $0011; { vt_ui1         }
  varWord     = $0012; { vt_ui2         }
  varLongWord = $0013; { vt_ui4         }
  varInt64    = $0014; { vt_i8          }
  varShortInt = $0010; { vt_i1       16 }

type
  TVarType = Word;

{ PChar/PWideChar Unicode <-> UTF8 conversion }
type
  UTF8String = type string;
  PUTF8String = ^UTF8String;

// UnicodeToUTF8(3):
// UTF8ToUnicode(3):
// Scans the source data to find the null terminator, up to MaxBytes
// Dest must have MaxBytes available in Dest.
// MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
// Function result includes the null terminator.

function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: Integer): Integer; overload;
function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: Integer): Integer; overload;

// UnicodeToUtf8(4):
// UTF8ToUnicode(4):
// MaxDestBytes includes the null terminator (last char in the buffer will be set to null)
// Function result includes the null terminator.
// Nulls in the source data are not considered terminators - SourceChars must be accurate

function UnicodeToUtf8(Dest: PChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; overload;
function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PChar; SourceBytes: Cardinal): Cardinal; overload;

{ WideString <-> UTF8 conversion }

function UTF8Encode(const WS: WideString): UTF8String;
function UTF8Decode(const S: UTF8String): WideString;

{ Ansi <-> UTF8 conversion }

function AnsiToUtf8(const S: string): UTF8String;
function Utf8ToAnsi(const S: UTF8String): string;
{$ENDIF}

{$IFNDEF FG_D7}
{ Copied from Delphi7 Classes.pas unit}
type
  TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;
    var Root, LookupRoot, RootAncestor: TComponent) of object;

function AncestorIsValid(Ancestor: TPersistent; Root,
  RootAncestor: TComponent): Boolean;
function IsDefaultPropertyValue(Instance: TObject; PropInfo: PPropInfo;
  OnGetLookupInfo: TGetLookupInfoEvent): Boolean;
{$ENDIF}

{$IFNDEF FG_D12}
function  RectWidth(const ARect: TRect): integer;
function  RectHeight(const ARect: TRect): integer;
{$ENDIF}

implementation