flatutils.pas

comerose_flatstyle_v4.42.9.0_d7.rar

unit FlatUtils;

interface

{$I FlatStyle.inc}

uses Windows, Classes, Graphics, Messages, Controls,
     StdCtrls, ComCtrls, SysUtils, DBGrids, Grids;

const
  FileVersion = '4.42.8.0';
  //定义 控件标签 开关 值:True为显示,False为禁止
  DefaultHasTicket = True;

type
  TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
  TButtonState  = (bsUp, bsDisabled, bsDown, bsExclusive);
  TButtonStyle  = (bsAutoDetect, bsWin31, bsNew);
  TWaterAlign   = (wpLeft,wpCenter,wpRight);
  TNumGlyphs    =  1..4;
  TAdvColors    =  0..100;
  //定义颜色语言结构
  TColorItems = packed record
    Value: TColor;
    cnName, enName: PAnsiChar;
  end;
  TIPChar = string[3];
  //定义IP分段函数
  TIP = packed Record
    NO1, NO2, NO3, NO4:TIPChar;
  end;
  TBarsRect = packed record
    PrevRect:TRect;
    DownRect:TRect;
  end;
  TWaterColor = packed record
    Value: TColor;
    enName: PAnsiChar;
  end;
  TBorderAttrib = packed record
    Ctrl: TWinControl;
    BorderColor: TColor;
    FlatColor: TColor;
    FocusColor: TColor;
    MouseState: Boolean;
    DesignState: TComponentState;
    FocusState: boolean;
    HasBars: boolean;
  end;
  TOtherParam = packed record
    Color: TColor;
    Name: TFontName;
    Pitch: TFontPitch;
    Size: Integer;
    Style: TFontStyles;
    Row: Integer;
    Draw3D: Boolean;
    Align: TWaterAlign;
  end;
  TScrollType        = (stUp, stDown);
  TColorCalcType     = (lighten, darken);
  TLayoutPosition    = (lpLeft, lpRight);
  TFlatTabPosition   = (fpTop, fpBottom);
  TArrowPos          = (NE, NW, SE, SW);
  TGroupBoxBorder    = (brFull, brOnlyTopLine);
  TTransparentMode   = (tmAlways, tmNotFocused, tmNone);
  TLanguage          = (lgChinese, lgEnglish);
  TStyleOrien        = (bsHorizontal, bsVertical);
  TStyleFace         = (fsDefault, fsCustom);
  TAlignmentText     = (stLeft, stCenter, stRight);
  TCheckPosition     = (bpLeft, bpRight);
  TTitlePosition     = (tsTop, tsBottom);
  TTicketPosition    = (poLeft, poTop, poRight, poBottom);
  TSplitterStatus    = (ssIn, ssOut);
  TListState         = (lsClear,lsFree);

  TNotifyChange    = procedure(Sender: TObject; Text:TCaption) of object;
  TNotifyClick     = procedure(Sender: TObject; Text:TCaption) of object;
  TValidateEvent   = Procedure(Sender: TObject) of Object;
  TOnFrameChange   = procedure(Sender: TObject; FrameNumber: Integer) of object;
  TAnimationLayout = (alAcross, alDown);

const
  //定义Style属性的初始化值
  DefaultBarColor         = TColor($00C5D6D9);
  DefaultBorderColor      = TColor($00FF8000);
  DefaultShadowColor      = TColor($00C6C600);
  DefaultFlatColor        = TColor($00E1EAEB);
  DefaultTitleFaceColor   = TColor($0000CECE);
  DefaultTitleCheckColor  = TColor($00FF8000);
  DefaultFocusedColor     = TColor($00FBBE99);
  DefaultCheckBorderColor = TColor($008396A0);
  DefaultCheckColor       = TColor($00FF0080);
  DefaultDownColor        = TColor($00C5D6D9);
  DefaultItemRectColor    = clWhite;
  DefaultBackdropColor    = clWhite;
  DefaultCheckBackColor   = clWhite;
  DefaultCheckSelectColor = clPurple;
  DefaultSelectStartColor = clBlack;
  DefaultSelectStopColor  = clWhite;
  DefaultColorStart       = clGray;
  DefaultColorStop        = clWhite;
  DefaultItemColorStart   = clOlive;
  DefaultTitleColor       = clBtnFace;
  DefaultItemLineColor    = clGray;
  DefaultItemColorStop    = clWhite;
  DefaultStyleVertical    = bsVertical;
  DefaultStyleHorizontal  = bsHorizontal;
  DefaultStyleFace        = fsDefault;
  DefaultItemHeight       = 17;
  DefaultBarsHeight       = 12;
  DefaultTitleHeight      = 18;
  //定义键盘控制
  vk_selall               = $41;//全选 Ctrl+A
  vk_selcancel            = $5A;//取消全选 Ctrl+Z
  //定义颜色语言默认
  clCustom                = TColor($4080FF);
  StdColorCount           = 18;
  StdCustomCN             = '自定';
  StdCustomEN             = 'Custom';
  StdColorCN              = '颜色:';
  StdColorEN              = 'Color:';  
  StdColors: array [0..StdColorCount] of TColorItems = (
  {00}(Value:clBlack;       cnName:'黑色';  enName:'Black'  ),
  {01}(Value:clWhite;       cnName:'白色';  enName:'White'  ),
  {02}(Value:clYellow;      cnName:'黄色';  enName:'Yellow' ),
  {03}(Value:clRed;         cnName:'红色';  enName:'Red'    ),
  {04}(Value:clFuchsia;     cnName:'紫红';  enName:'Fuchsia'),
  {05}(Value:clMaroon;      cnName:'栗色';  enName:'Maroon' ),
  {06}(Value:clGreen;       cnName:'绿色';  enName:'Green'  ),
  {07}(Value:clAqua;        cnName:'浅绿';  enName:'Aqua'   ),
  {08}(Value:clMoneyGreen;  cnName:'金绿';  enName:'MoneyGreen'),
  {09}(Value:clBlue;        cnName:'蓝色';  enName:'Blue'   ),
  {10}(Value:clTeal;        cnName:'深蓝';  enName:'Teal'   ),
  {11}(Value:clSkyBlue;     cnName:'天蓝';  enName:'SkyBlue'),
  {12}(Value:clOlive;       cnName:'橄榄';  enName:'Olive'  ),
  {13}(Value:clNavy;        cnName:'藏青';  enName:'Navy'   ),
  {14}(Value:clPurple;      cnName:'紫色';  enName:'Purple' ),
  {15}(Value:clGray;        cnName:'灰色';  enName:'Gray'   ),
  {16}(Value:clSilver;      cnName:'银灰';  enName:'Silver' ),
  {17}(Value:clLime;        cnName:'青色';  enName:'Lime'   ),
  {18}(Value:clCustom;      cnName:'自定';  enName:'Custom'));

  //定义 输入类控件 的输入位置
  Aligns:array[TAlignment] of word =(ES_LEFT,ES_RIGHT,ES_CENTER);

  ecDarkBlue    = TColor($00996633);
  ecBlue        = TColor($00CF9030);
  ecLightBlue   = TColor($00CFB78F);
  ecDarkRed     = TColor($00302794);
  ecRed         = TColor($005F58B0);
  ecLightRed    = TColor($006963B6);
  ecDarkGreen   = TColor($00385937);
  ecGreen       = TColor($00518150);
  ecLightGreen  = TColor($0093CAB1);
  ecDarkYellow  = TColor($004EB6CF);
  ecYellow      = TColor($0057D1FF);
  ecLightYellow = TColor($00B3F8FF);
  ecDarkBrown   = TColor($00394D4D);
  ecBrown       = TColor($00555E66);
  ecLightBrown  = TColor($00829AA2);
  ecDarkKaki    = TColor($00D3D3D3);
  ecKaki        = TColor($00C8D7D7);
  ecLightKaki   = TColor($00E0E9EF);

  { Encarta & FlatStyle Interface Color Constants }
  ecBtnHighlight      = clWhite;
  ecBtnShadow         = clBlack;
  ecBtnFace           = ecLightKaki;
  ecBtnFaceDown       = ecKaki;
  ecFocused           = clWhite;
  ecScrollbar         = ecLightKaki;
  ecScrollbarThumb    = ecLightBrown;
  ecBackground        = clWhite;
  ecHint              = ecYellow;
  ecHintArrow         = clBlack;
  ecDot               = clBlack;
  ecTick              = clBlack;
  ecMenuBorder        = ecDarkBrown;
  ecMenu              = clBlack;
  ecMenuSelected      = ecDarkYellow;
  ecProgressBlock     = ecBlue;
  ecUnselectedTab     = ecBlue;
  ecSelection         = clNavy;
  ecCaptionBackground = clBlack;
  ecActiveCaption     = clWhite;
  ecInactiveCaption   = ecLightBrown;

  BS_XP_BTNFRAMECOLOR  = 8388608;
  BS_XP_BTNACTIVECOLOR = 13811126;
  BS_XP_BTNDOWNCOLOR   = 11899781;
  //define ipmaskedit
  IPMaskStr = '999\.999\.999\.999;1;'#32;
  IPStart   = '0.0.0.0';
  //定义水波字幕控制脚本
  TitleStart  = '<Title>';
  TitleEnd    = '</Title>';
  TitleSize   = '[Size:';
  TitleName   = '[Name:';
  TitleStyle  = '[Style:';
  TitleColor  = '[Color:';
  TitleLow    = '[Row:';
  TitlePitch  = '[Pitch:';
  TitleDraw3D = '[Draw3D:';
  TitleAlign  = '[Align:';
  WaterColor: array [0..17] of TWaterColor = (
  {00}(Value:clBlack;       enName:'clBlack'  ),
  {01}(Value:clWhite;       enName:'clWhite'  ),
  {02}(Value:clYellow;      enName:'clYellow' ),
  {03}(Value:clRed;         enName:'clRed'    ),
  {04}(Value:clFuchsia;     enName:'clFuchsia'),
  {05}(Value:clMaroon;      enName:'clMaroon' ),
  {06}(Value:clGreen;       enName:'clGreen'  ),
  {07}(Value:clAqua;        enName:'clAqua'   ),
  {08}(Value:clMoneyGreen;  enName:'clMoneyGreen'),
  {09}(Value:clBlue;        enName:'clBlue'   ),
  {10}(Value:clTeal;        enName:'clTeal'   ),
  {11}(Value:clSkyBlue;     enName:'clSkyBlue'),
  {12}(Value:clOlive;       enName:'clOlive'  ),
  {13}(Value:clNavy;        enName:'clNavy'   ),
  {14}(Value:clPurple;      enName:'clPurple' ),
  {15}(Value:clGray;        enName:'clGray'   ),
  {16}(Value:clSilver;      enName:'clSilver' ),
  {17}(Value:clLime;        enName:'clLime'   ));
  
//define components main version infomation
type
  { TVersionControl }
  TVersionControl = Class(TCustomControl)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
    property Font;
  end;

  { TVersionComboBox }
  TVersionComboBox = Class(TCustomComboBox)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionGraphic = class(TGraphicControl)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionTreeView = class(TCustomTreeView)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionListView = class(TCustomListView)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionMemo = class(TCustomMemo)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionEdit = class(TCustomEdit)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionComponent = class(TComponent)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionListBoxExt = class(TCustomListBox)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionDBGrid = class(TDBGrid)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;

  TVersionDrawGrid = class(TCustomDrawGrid)
  private
    FVersion: String;
    function GetVersion: String;
  published
    property Version: String read GetVersion write FVersion;
  end;
//定义 重画控件边界函数
function  DrawEditBorder(Border:TBorderAttrib; const Clip: HRGN=0):TColor;
procedure DrawButtonBorder(Canvas: TCanvas;Rect: TRect; Color: TColor; Width: Integer);
function  DrawViewBorder(ViewBorder: TBorderAttrib;const oVal:Byte=1):TColor;
procedure DrawInCheck(Canvas:TCanvas; Rect:TRect; Color:TColor);
procedure DrawFrame(Canvas: TCanvas; var Rect: TRect; BorderColor, FaceColor: TColor; Width: Integer);
//定义 重画透明背景
procedure DrawTransBitBlt(Cnv: TCanvas; x, y: Integer; Bmp: TBitmap; clTransparent: TColor);
//定义 画父背景图像
procedure DrawParentImage(Control: TControl; Dest: TCanvas);
function  CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor, BackColor, HighlightColor, ShadowColor: TColor;
                               DrawHighlight: Boolean): TBitmap;
function  CalcAdvancedColor(ParentColor, OriginalColor: TColor; Percent: Byte; ColorType: TColorCalcType): TColor;
procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect; const Offset: TPoint; Layout: TButtonLayout;
                           Spacing, Margin: Integer; FGlyph: TBitmap; FNumGlyphs: Integer;
                           const Caption: string; var TextBounds: TRect; var GlyphPos: TPoint);
function  Min(const A, B: Integer): Integer;
function  Max(const A, B: Integer): Integer;
function  GetFontMetrics(Font: TFont): TTextMetric;
function  GetFontHeight(Font: TFont): Integer;
function  RectInRect(R1, R2: TRect): Boolean;
procedure DrawBackdrop(Canvas:TCanvas; StartColor, StopColor: TColor; CanRect:TRect;Style:TStyleOrien);
function  IndexInCount(Index,Count:Integer):boolean;
procedure DrawFocusRect(Canvas:TCanvas;FocusRect:TRect;Height:Integer);
procedure SetTicketPoint(Value:TTicketPosition;Self,Ticket:TControl;TicketSpace:Integer);
procedure GetStyleText(Value:TAlignmentText; var Result:UINT);
procedure GetCheckBoxPosition(Value:TCheckPosition; var Result:UINT);  
procedure DrawCheckBox(BoxRect:TRect; Position:TCheckPosition; Size:Integer; Var CheckRect:TRect);
procedure GetBarPosition(ClientRect:TRect;TitleHas:boolean;TitlePosition:TTitlePosition;
                         Var BarsRect:TBarsRect; TitleHeight, BarHeight:Integer);
procedure BoxDrawBackDrop(Canvas:TCanvas;ColorStart,ColorStop:TColor;Style:TStyleOrien;
                          ClientRect:TRect;ItemColor:TColor;Face:TStyleFace);
procedure DrawBitmap(Canvas:TCanvas; DrawRect:TRect; Source:TBitmap);
procedure FlatDrawText(Canvas: TCanvas; Enabled: Boolean; Caption: TCaption; DrawRect:TRect; Format:uint);
function  CheckValue(Value,MaxValue,MinValue: LongInt): LongInt;
function  RectWidth(R: TRect): Integer;
function  RectHeight(R: TRect): Integer;
function  DrawEllipse(Handle: HDC; Rect: TRect): BOOL;
function  RectToCenter(var R: TRect; Bounds: TRect): TRect;
procedure CorrectTextbyWidth(C: TCanvas; var S: String; W: Integer);
//定义 IP控制函数
procedure IPEmpty(Var IP:TIP);
procedure IPValue(Var IP:TIP;Inx:Word;Value:TIPChar);
//定义 释放指针列表函数
procedure RemoveList(List:TList; State:TListState=lsClear);
//定义 重设列表区域函数
procedure SetEditRect(Handle:HWnd; ClientWidth,ClientHeight,Width:Integer);
//定义 水波字幕解析函数
procedure GetTitleParam(Var Font: TOtherParam; Var Title:String);
function  GetParamColor(Value:String):TColor;
function  GetParamDraw3D(Value:String): Boolean;
function  GetParamStyle(Value:String): TFontStyles;
function  GetParamValue(Var Value:String; Param:String):String;

var
  HSLRange: integer = 240;

implementation

procedure DrawFrame(Canvas: TCanvas; var Rect: TRect; BorderColor, FaceColor: TColor;
  Width: Integer);

  procedure DoRect;
  begin
    with Canvas, Rect do
    begin
      Pen.Color := BorderColor;
      MoveTo(Left,Top);
      LineTo(Left,Bottom);
      Pen.Color := FaceColor;
      MoveTo(Left,Bottom);
      LineTo(Right,Bottom);
      MoveTo(Left,Top);
      LineTo(Right,Top);  
    end;
  end;

begin
  Canvas.Pen.Width := 1;
  inc(Rect.Left);
  Dec(Rect.Bottom); Dec(Rect.Right);
  while Width > 0 do
  begin
    Dec(Width);
    DoRect;
    InflateRect(Rect, -1, -1);
  end;
  Inc(Rect.Bottom); Inc(Rect.Right);
  dec(Rect.Left);
end;

procedure DrawInCheck(Canvas:TCanvas; Rect:TRect; Color:TColor);
var x,y,yTop:Word;
begin
 with Canvas, Rect do
 begin
  yTop := (Right - Left - 12) div 2;
     x :=  Left + yTop;
     y :=  Top + yTop;
  Pen.Color := Color;
  PenPos  := Point(x+2, y+5);
  LineTo(x+4,y+7);
  PenPos  := Point(x+4, y+7);
  LineTo(x+10,y+1);
  PenPos  := Point(x+2, y+6);
  LineTo(x+4,y+8);
  PenPos  := Point(x+4, y+8);
  LineTo(x+10,y+2);
  PenPos  := Point(x+2, y+7);
  LineTo(x+4,y+9);
  PenPos  := Point(x+4, y+9);
  LineTo(x+10,y+3);
 end;
end;

function DrawEditBorder(Border:TBorderAttrib; const Clip: HRGN=0):TColor;
var
  DC: HDC;
  R, BarRect: TRect;
  BtnFaceBrush, WindowBrush, FocusBrush: HBRUSH;
begin
 with Border do
 begin
  DC := GetWindowDC(Ctrl.Handle);
  try
    GetWindowRect(Ctrl.Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    BtnFaceBrush := CreateSolidBrush(ColorToRGB(BorderColor));
    WindowBrush  := CreateSolidBrush(ColorToRGB(FlatColor));
    FocusBrush   := CreateSolidBrush(ColorToRGB(FocusColor));
    BarRect      := Rect(R.Right - 20, R.Bottom - 20, R.Right - 1, R.Bottom - 1);
    if (not(csDesigning in DesignState) and (FocusState or MouseState)) then
    begin
      // Focus
      result := FocusColor;
      FrameRect(DC, R, BtnFaceBrush);
      InflateRect(R, -1, -1);
      FrameRect(DC, R, FocusBrush);
      InflateRect(R, -1, -1);
      FrameRect(DC, R, FocusBrush);
      if HasBars then FillRect(DC, BarRect , FocusBrush);
    end
    else
    begin
      // non Focus
      result := FlatColor;
      FrameRect(DC, R, BtnFaceBrush);
      InflateRect(R, -1, -1);
      FrameRect(DC, R, WindowBrush);
      InflateRect(R, -1, -1);
      FrameRect(DC, R, WindowBrush);
      if HasBars then FillRect(DC, BarRect, WindowBrush);
    end;
  finally
    ReleaseDC(Ctrl.Handle, DC);
  end;
  DeleteObject(WindowBrush);
  DeleteObject(BtnFaceBrush);
  DeleteObject(FocusBrush);
 end;
end;

procedure DrawButtonBorder(Canvas: TCanvas; Rect: TRect; Color: TColor; Width: Integer);
  procedure DoRect;
  var
    TopRight, BottomLeft: TPoint;
  begin
    with Canvas, Rect do begin
      TopRight.X   := Right;
      TopRight.Y   := Top;
      BottomLeft.X := Left;
      BottomLeft.Y := Bottom;
      Pen.Color    := Color;
      PolyLine([BottomLeft, TopLeft, TopRight]);
      Pen.Color    := Color;
      Dec(BottomLeft.X);