se_controls.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 1,763 行 · 第 1/5 页

    FBitmap: TBitmap;
    FBitmapTrCount: integer;
    FOnBeforeChange: TNotifyEvent;
    function  GetPixel(X, Y: Integer): TKColor;
    procedure SetPixel(X, Y: Integer; Value: TKColor);
    procedure SetHeight(const Value: integer);
    procedure SetFont(const Value: TFont);
    procedure SetWidth(const Value: integer);
    function GetPixelPtr(X, Y: Integer): PKColor;
    procedure DrawMarginRectDDB(DC: HDC; MarginRect,
      MarginDstRect: TRect; Stretch: boolean; Transparent: boolean = false); overload;
    procedure DrawMarginRect(Buffer: TSeBitmap; MarginRect,
      MarginDstRect: TRect; Stretch: boolean); overload;
    procedure DrawMarginRect(Canvas: TCanvas; MarginRect,
      MarginDstRect: TRect; Stretch: boolean; Transparent: boolean = false); overload;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dst: TPersistent); override;
    procedure SetSize(AWidth, AHeight: Integer);

    function  Empty: Boolean;
    procedure Changed;

    procedure Clear(Color: TKColor);
    procedure PerformTransparent(Color: TKColor);
    procedure PerformTransparentRect(Color: TKColor; ARect: TRect);

    procedure FillRect(R: TRect; Color: TKColor);
    procedure FillRoundRect(R: TRect; Radius: integer; Color: TKColor);
    procedure FillHalftoneRect(R: TRect; Color, HalfColor: TKColor);
    procedure FillGradientRect(Rect: TRect; BeginColor, EndColor: TKColor;
      Vertical: boolean);
    procedure FillRadialGradientRect(Rect: TRect; BeginColor, EndColor: TKColor;
      Pos: TPoint);
    procedure FillEllipse(R: TRect; Color: TKColor);

    procedure DrawEdge(R: TRect; RaisedColor, SunkenColor: TKColor);
    procedure DrawBevel(R: TRect; Color: TKColor; Width: integer; Down: boolean);
    procedure DrawRect(R: TRect; Color: TKColor);
    procedure DrawFocusRect(R: TRect; Color: TKColor);
    procedure DrawRoundRect(R: TRect; Radius: integer; Color: TKColor);
    procedure DrawLine(R: TRect; Color: TKColor);
    procedure DrawEllipse(R: TRect; Color: TKColor);

    procedure MoveTo(X, Y: integer);
    procedure LineTo(X, Y: integer; Color: TKColor);
    procedure DrawPolygon(Points: array of TPoint; Color: TColor);
    procedure FillPolygon(Points: array of TPoint; Color: TColor);
    procedure FillHalftonePolygon(Points: array of TPoint; Color, HalfColor: TKColor);

    function DrawText(AText: string; var Bounds: TRect; Flag: cardinal): integer; overload;
    function DrawText(AText: string; X, Y: integer): integer; overload;
    procedure DrawVerticalText(AText: string; Bounds: TRect; Flag: cardinal;
      FromTop: boolean);
    function TextWidth(AText: string; Flags: Integer = 0): integer;
    function TextHeight(AText: string): integer;

    procedure Draw(DC: HDC; X, Y: integer; Transparent: boolean = false); overload;
    procedure Draw(DC: HDC; X, Y: integer; SrcRect: TRect; Transparent: boolean = false); overload;
    procedure Draw(DC: HDC; DstRect, SrcRect: TRect; Transparent: boolean = false); overload;
    procedure Draw(Canvas: TCanvas; X, Y: integer; Transparent: boolean = false); overload;
    procedure Draw(Canvas: TCanvas; X, Y: integer; SrcRect: TRect; Transparent: boolean = false); overload;
    procedure Draw(Canvas: TCanvas; DstRect, SrcRect: TRect; Transparent: boolean = false); overload;
    procedure Draw(Bitmap: TSeBitmap; X, Y: integer); overload;
    procedure Draw(Bitmap: TSeBitmap; X, Y: integer; SrcRect: TRect); overload;
    procedure Draw(Bitmap: TSeBitmap; DstRect, SrcRect: TRect); overload;

    procedure DrawTile(Bitmap: TSeBitmap; DstRect, SrcRect: TRect); overload;
    procedure DrawTile(Canvas: TCanvas; DstRect, SrcRect: TRect; Transparent: boolean = false); overload;

    procedure DrawMargin(Canvas: TCanvas; DstRect, SrcRect: TRect;
      MarginLeft, MarginTop, MarginRight, MarginBottom: integer; Stretch: boolean; Transparent: boolean = false); overload;
    procedure DrawMargin(Bitmap: TSeBitmap; DstRect, SrcRect: TRect;
      MarginLeft, MarginTop, MarginRight, MarginBottom: integer; Stretch: boolean); overload;

    { DDB Routines }
    procedure DDBNeed;
    procedure MaskNeed(Color: TColor);
    procedure DrawDDB(DC: HDC; X, Y: integer; Transparent: boolean = false); overload;
    procedure DrawDDB(DC: HDC; X, Y: integer; SrcRect: TRect; Transparent: boolean = false); overload;
    procedure DrawDDB(DC: HDC; DstRect, SrcRect: TRect; Transparent: boolean = false); overload;

    procedure DrawTileDDB(DC: HDC; DstRect, SrcRect: TRect; Transparent: boolean = false); overload;
    procedure DrawMarginDDB(DC: HDC; DstRect, SrcRect: TRect;
      MarginLeft, MarginTop, MarginRight, MarginBottom: integer; Stretch: boolean;
      Transparent: boolean = false); overload;

    procedure MergeDraw(Bitmap: TSeBitmap; X, Y: integer; SrcRect: TRect); overload;

    procedure SetAlpha(Alpha: byte); overload;
    procedure SetAlpha(Alpha: byte; Rect: TRect); overload;

    procedure ChangeBitmapHue(DeltaHue: integer);
    procedure ChangeBitmapBrightness(DeltaBrightness: integer);

    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromBmpFile(const FileName: string);
    procedure SaveToBmpFile(const FileName: string);
    procedure LoadFromBmpStream(Stream: TStream);
    procedure LoadFromPcxStream(Stream: TStream);

    function GetBitmapLink(Rect: TRect): TSeBitmapLink; overload;
    function GetBitmapLink(Rect: string): TSeBitmapLink; overload;

    property Pixels[X, Y: Integer]: TKColor read GetPixel write SetPixel; default;
    property PixelPtr[X, Y: Integer]: PKColor read GetPixelPtr;
    property Bits: PKColorArray read FBits;

    property Font: TFont read FFont write SetFont;

    property Width: integer read FWidth write SetWidth;
    property Height: integer read FHeight write SetHeight;

    property Name: string read FName write FName;

    property Blend: boolean read FBlend write FBlend;

    property Handle: HBITMAP read FHandle;
    property BitmapInfo: TBitmapInfo read FBitmapInfo;
    property DC: HDC read FDC;
    property Tag: integer read FTag write FTag;

    property OnBeforeChange: TNotifyEvent read FOnBeforeChange write FOnBeforeChange;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  published
  end;


{ TSeBitmapLink }

  TSeBitmapLink = class(TPersistent)
  private
    FBitmap: TSeBitmap;
    FRect: TRect;
    FName: string;
    function GetBottom: integer;
    function GetLeft: integer;
    function GetRight: integer;
    function GetTop: integer;
    procedure SetBottom(const Value: integer);
    procedure SetLeft(const Value: integer);
    procedure SetRight(const Value: integer);
    procedure SetTop(const Value: integer);
    function GetAssigned: boolean;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;

    procedure Draw(Canvas: TCanvas; X, Y: integer); overload;
    procedure Draw(Bitmap: TSeBitmap; X, Y: integer); overload;

    property Assigned: boolean read GetAssigned;
    property Bitmap: TSeBitmap read FBitmap write FBitmap;
    property Rect: TRect read FRect write FRect;
  published
    property Name: string read FName write FName;
    property Left: integer read GetLeft write SetLeft;
    property Top: integer read GetTop write SetTop;
    property Right: integer read GetRight write SetRight;
    property Bottom: integer read GetBottom write SetBottom;
  end;

{ TSeBitmapList }

  TSeBitmapList = class(TList)
  private
    function GetBitmap(index: integer): TSeBitmap;
    function GetBitmapByName(index: string): TSeBitmap;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Clear; override;

    function GetBitmapLink(Bitmap: TSeBitmap; Rect: TRect): TSeBitmapLink; overload;
    function GetBitmapLink(Name: string; Rect: TRect): TSeBitmapLink; overload;
    function GetBitmapLink(Name, Rect: string): TSeBitmapLink; overload;

    property Bitmaps[index: integer]: TSeBitmap read GetBitmap; default;
    property BitmapByName[index: string]: TSeBitmap read GetBitmapByName; 
  end;

{ Color functions }

function KColor(Color: TColor; A: Byte = $FF): TKColor; overload;
function KColor(R, G, B: SmallInt; A: Byte = $FF): TKColor; overload;
function KColor(ColorRec: TKColorRec): TKColor; overload;

function KColorToColor(Color: TKColor): TColor;

function RaisedColor(Color: TKColor; DR, DG, DB: byte; DA: byte = 0): TKColor; overload;
function SunkenColor(Color: TKColor; DR, DG, DB: byte; DA: byte = 0): TKColor; overload;
function RaisedColor(Color: TKColor; Dx: byte): TKColor; overload;
function SunkenColor(Color: TKColor; Dx: byte): TKColor; overload;

function HSLtoRGB(H, S, L: Single): TKColor;
procedure RGBtoHSL(RGB: TKColor; out H, S, L: single);

function ChangeHue(Color: TKColor; DeltaHue: integer): TKColor;
function ChangeBrightness(Color: TKColor; DeltaBrightness: integer): TKColor;

{ Windows Blending }

const

  EnableWindowsBlend = true;

type

  TBlendFunction = record
    BlendOp,BlendFlags,Alpha,Format: Byte;
  end;

var

  AlphaBlend: function (hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
    nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
    nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;

  TransparentBlt: function (hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
    nHeightSrc: Integer; hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
    nHeightDest: Integer; Color: Longint): BOOL; stdcall;


{ Strings functions }

function GetToken(var S: string): string;

function RectToString(R: TRect): string;
function StringToRect(S: string): TRect;

function FormatStr(DC: HDC; S: WideString; Width: integer): WideString; overload;
function FormatStr(Bitmap: TSeBitmap; S: WideString; Width: integer): WideString; overload;

{ Rect, Point and Polygon }

function RectWidth(R: TRect): integer;
function RectHeight(R: TRect): integer;
function RectHCenter(var R: TRect; Bounds: TRect): TRect;
function RectVCenter(var R: TRect; Bounds: TRect): TRect;
function RectCenter(var R: TRect; Bounds: TRect): TRect;
function RectOffset(ARect: TRect; Offset: integer): TRect;
function IsRectEmpty(Rect: TRect): boolean;
function CompareRect(Rect1, Rect2: TRect): boolean;

function PointInPolygon(const P: TPoint; const Points: array of TPoint): boolean;

{ Drawing routines }

procedure DrawFrameControlGlyph(Canvas: TCanvas; ARect: TRect; AType, AStyle: cardinal; Color: TColor);

function DrawText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag: cardinal): integer; overload;
function DrawText(ACanvas: TCanvas; AText: WideString; X, Y: integer): integer; overload;
function DrawVerticalText(Canvas: TCanvas; AText: WideString; Bounds: TRect; Flag: cardinal; FromTop: boolean): integer;

function TextWidth(Canvas: TCanvas; AText: WideString; Flags: Integer = 0): integer;
function TextHeight(Canvas: TCanvas; AText: WideString): integer;

procedure MoveTo(Canvas: TCanvas; X, Y: integer);
procedure LineTo(Canvas: TCanvas; X, Y: integer; Color: TColor);

procedure DrawEdge(Canvas: TCanvas; Rect: TRect; RaisedColor, SunkenColor: TColor); overload;
procedure DrawEdge(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; RaisedColor, SunkenColor: TColor); overload;

procedure DrawRect(Canvas: TCanvas; Rect: TRect; Color: TColor); overload;
procedure DrawRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor); overload;

procedure DrawFocusRect(Canvas: TCanvas; Rect: TRect; Color: TColor);

procedure DrawBevel(Canvas: TCanvas; var R: TRect; BevelSides: TSeBevelSides; Width: integer; RaisedColor, SunkenColor: TColor);

procedure FillRect(Canvas: TCanvas; Rect: TRect; Color: TColor); overload;
procedure FillRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor); overload;

procedure DrawRoundRect(Canvas: TCanvas; ARect: TRect; Radius: integer; Color: TColor);
procedure FillRoundRect(Canvas: TCanvas; ARect: TRect; Radius: integer; Color: TColor);
procedure FillGradientRect(Canvas: TCanvas; ARect: TRect; BeginColor, EndColor: TColor; Vertical: boolean);
procedure FillHalftoneRect(Canvas: TCanvas; ARect: TRect; Color, HalfColor: TColor);

procedure DrawPolygon(Canvas: TCanvas; Points: array of TPoint; Color: TColor);
procedure FillPolygon(Canvas: TCanvas; Points: array of TPoint; Color: TColor);
procedure FillHalftonePolygon(Canvas: TCanvas; Points: array of TPoint; Color, HalfColor: TColor);

procedure DrawIcon(Canvas: TCanvas; ARect: TRect; AIcon: TIcon);

{ Graphics routines }

function GetPlasma(const Color, PlasmaColor: TKColor): TSeBitmap;

{ Stream routines }

function ReadString(S: TStream): string;
procedure WriteString(S: TStream; Value: string);

{ Region }

function CreateRegionFromBitmap(Bitmap: TSeBitmap; Left, Top: integer): HRgn;

{ System }

function GetKeyBoardDelayInterval: integer;
function GetKeyBoardSpeedInterval: integer;

{ Mouse capture }

const
  CaptureHandle: Hwnd = 0;

procedure CaptureMouse(const Wnd: HWND);
procedure EndCapture;

{ Utils }

{$IFNDEF KS_COMPILER5_UP}
procedure FreeAndNil(var Obj);
{$ENDIF}

{ Windows version information }

const

  IsWindowsNT: boolean = false;


type

{ TObjectList class }

  TObjectList = class(TList)
  private
    FOwnsObjects: Boolean;
  protected
    function GetItem(Index: Integer): TObject;
    procedure SetItem(Index: Integer; AObject: TObject);
  public
    constructor Create; overload;
    constructor Create(AOwnsObjects: Boolean); overload;

    function Add(AObject: TObject): Integer;
    function Remove(AObject: TObject): Integer;
    function IndexOf(AObject: TObject): Integer;
    function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer;
    procedure Insert(Index: Integer; AObject: TObject);