newabelsoft.pas

delphi写的对学习delphi初级入门的数据编程很有用。是用用来查找硬盘mp3文件

    procedure SetCtl3D(Value: boolean);
    procedure SetBorder(Value: TBorder);
    procedure FTimerOnTimer(sender:TObject);
    procedure SetHiColor(value: TColor);
    procedure SetLoColor(value: TColor);

  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;

  published
    { Hi Color, when "Blink" is blHiLo }
    property HiColor: TColor read FHiColor write SetHiColor;
    { Lo Color, when "Blink" is blHiLo }
    property LoColor: TColor read FLoColor write SetLoColor;
    property Border: TBorder read FBorder write SetBorder;
    property Ctl3D: boolean read FCtl3D write SetCtl3D;
    { speed of blinking }
    property BlinkInterval: integer read FInterval write SetInterval;
    property Blink: TBlink read FBlink write SetBlink;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnHighlight;
    property Deep: byte read FDeep write SetDeep;
  end;

{$IFDEF VER130}
{$DEFINE VER5U}
{$ENDIF}

{$IFDEF VER140}
{$DEFINE VER5U}
{$DEFINE VER6U}
{$ENDIF}

type

  TXPContainer = (xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel,
                  xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller);
  TXPContainers = set of TXPContainer;

  TXPControl = (xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo,
                xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcCheckBox, xcRadioButton,
                xcButton, xcBitBtn, xcSpeedButton, xcPanel, xcGroupBox);

  TXPControls = set of TXPControl;

  TXPMenu = class;
  TControlSubClass = class(TComponent)  
  private
    Control: TControl;
    FBuilding: boolean;
    FMouseInControl: boolean;
    FLButtonBressed: boolean;
    FBressed: boolean;
    FIsKeyDown: boolean;
    FIsFocused: boolean;
    orgWindowProc: TWndMethod;
    XPMenu: TXPMenu;
    FCtl3D: boolean;
    FBorderStyle: TBorderStyle;
    FMsg: Cardinal;
    procedure ControlSubClass(var Message: TMessage);
    procedure PaintControlXP;
    procedure PaintCombo;
    procedure PaintEdit;
    procedure PaintRichEdit;
    procedure PaintCheckBox;
    procedure PaintRadio;
    procedure PaintButton;
    procedure PaintBitButn;
    procedure PaintSpeedButton;
    procedure PaintPanel;
    procedure PaintGroupBox;

  end;

  TXPMenu = class(TComponent)
  private
    FActive: boolean;
    {Changes MMK FForm to TScrollingWinControl}
    FForm: TScrollingWinControl;
    FFont: TFont;
    FColor: TColor;
    FIconBackColor: TColor;
    FMenuBarColor: TColor;
    FCheckedColor: TColor;
    FSeparatorColor: TColor;
    FSelectBorderColor: TColor;
    FSelectColor: TColor;
    FDisabledColor: TColor;
    FSelectFontColor: TColor;
    FIconWidth: integer;
    FDrawSelect: boolean;
    FUseSystemColors: boolean;

    FFColor, FFIconBackColor, FFSelectColor, FFSelectBorderColor,
    FFSelectFontColor, FCheckedAreaColor, FCheckedAreaSelectColor,
    FFCheckedColor, FFMenuBarColor, FFDisabledColor, FFSeparatorColor,
    FMenuBorderColor, FMenuShadowColor: TColor;

    Is16Bit: boolean;
    FOverrideOwnerDraw: boolean;
    FGradient: boolean;
    FFlatMenu: boolean;
    FAutoDetect: boolean;
    FXPContainers: TXPContainers;
    FXPControls: TXPControls;
    FGrayLevel: byte;
    FDimLevel: byte;
  //  FDoubleBuffered :Boolean;
    procedure SetActive(const Value: boolean);
    procedure SetAutoDetect(const Value: boolean);
    procedure SetForm(const Value: TScrollingWinControl);
    procedure SetFont(const Value: TFont);
    procedure SetColor(const Value: TColor);
    procedure SetIconBackColor(const Value: TColor);
    procedure SetMenuBarColor(const Value: TColor);
    procedure SetCheckedColor(const Value: TColor);
    procedure SetDisabledColor(const Value: TColor);
    procedure SetSelectColor(const Value: TColor);
    procedure SetSelectBorderColor(const Value: TColor);
    procedure SetSeparatorColor(const Value: TColor);
    procedure SetSelectFontColor(const Value: TColor);
    procedure SetIconWidth(const Value: integer);
    procedure SetDrawSelect(const Value: boolean);
    procedure SetUseSystemColors(const Value: boolean);
    procedure SetOverrideOwnerDraw(const Value: boolean);
    procedure SetGradient(const Value: boolean);
    procedure SetFlatMenu(const Value: boolean);
    procedure SetXPContainers(const Value: TXPContainers);
    procedure SetXPControls(const Value: TXPControls);

  protected
    procedure InitItems(wForm: TWinControl; Enable, Update: boolean);
    procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    {$IFDEF VER5U}
    procedure ToolBarDrawButton(Sender: TToolBar;
      Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
    {$ENDIF}
    procedure ControlBarPaint(Sender: TObject; Control: TControl;
      Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);

    procedure ActivateMenuItem(MenuItem: TMenuItem);
    procedure SetGlobalColor(ACanvas: TCanvas);
    procedure DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      BckColor:Tcolor; IsRightToLeft: boolean);
    procedure DrawCheckedItem(FMenuItem: TMenuItem; Selected, Enabled,
     HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect);
    procedure DrawTheText(Sender: TObject; txt, ShortCuttext: string;
       ACanvas: TCanvas; TextRect: TRect;
       Selected, Enabled, Default, TopMenu, IsRightToLeft: boolean;
       var TxtFont: TFont; TextFormat: integer);
    procedure DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap;
     IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu,
     IsRightToLeft: boolean);
//    procedure DrawArrow(ACanvas: TCanvas; X, Y: integer);
    procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
      var Width, Height: Integer);

    function GetImageExtent(MenuItem: TMenuItem): TPoint;
    function TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor;
    procedure DrawGradient(ACanvas: TCanvas; ARect: TRect;
     IsRightToLeft: boolean);

    procedure DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean);

    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Form: TScrollingWinControl read FForm write SetForm;
  published
    property DimLevel: Byte read FDimLevel write FDimLevel;
    property GrayLevel: Byte read FGrayLevel write FGrayLevel;
    property Font: TFont read FFont write SetFont;
    property Color: TColor read FColor write SetColor;
    property IconBackColor: TColor read FIconBackColor write SetIconBackColor;
    property MenuBarColor: TColor read FMenuBarColor write SetMenuBarColor;
    property SelectColor: TColor read FSelectColor write SetSelectColor;
    property SelectBorderColor: TColor read FSelectBorderColor
     write SetSelectBorderColor;
    property SelectFontColor: TColor read FSelectFontColor
     write SetSelectFontColor;
    property DisabledColor: TColor read FDisabledColor write SetDisabledColor;
    property SeparatorColor: TColor read FSeparatorColor
     write SetSeparatorColor;
    property CheckedColor: TColor read FCheckedColor write SetCheckedColor;
    property IconWidth: integer read FIconWidth write SetIconWidth;
    property DrawSelect: boolean read FDrawSelect write SetDrawSelect;
    property UseSystemColors: boolean read FUseSystemColors
     write SetUseSystemColors;
    property OverrideOwnerDraw: boolean read FOverrideOwnerDraw
     write SetOverrideOwnerDraw;

    property Gradient: boolean read FGradient write SetGradient;
    property FlatMenu: boolean read FFlatMenu write SetFlatMenu;
    property AutoDetect: boolean read FAutoDetect write SetAutoDetect;
    property XPContainers: TXPContainers read FXPContainers write SetXPContainers
      default [xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel,
                  xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller];
    property XPControls :TXPControls read FXPControls write SetXPControls
      default [xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo,
               xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcCheckBox, xcRadioButton,
               xcButton, xcBitBtn, xcSpeedButton, xcPanel, xcGroupBox];

    property Active: boolean read FActive write SetActive;

  end;

function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
procedure DimBitmap(ABitmap: TBitmap; Value: integer);
procedure DrawArrow(ACanvas: TCanvas; X, Y: integer);
function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;

procedure GrayBitmap(ABitmap: TBitmap; Value: integer);
procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer;
  ShadowColor: TColor);
procedure DrawCheckMark(ACanvas: TCanvas; X, Y: integer);

procedure GetSystemMenuFont(Font: TFont);


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('NewabelSoft', [TArrow]);
  RegisterComponents('NewabelSoft', [TImageBtn]);
  RegisterComponents('NewabelSoft', [TDateEdit]);
  RegisterComponents('NewabelSoft', [TDBDateEdit]);
  RegisterComponents('NewabelSoft', [TSelectKeyID]);
  RegisterComponents('NewabelSoft', [TKeyIDCombo]);
  RegisterComponents('NewabelSoft', [TTrayIcon]);
  RegisterComponents('NewabelSoft', [TDyLabel]);
  RegisterComponents('NewabelSoft', [TXPMenu]);
end;

{TArrow}

procedure TArrow.WMSize(var message:TWMSize);
begin
  inherited;
  RePaint;
end;

constructor TArrow.Create;
begin
  inherited;
  Width := 100;
  Height := 30;
  FColor:=clWhite;
  FDirection:=adLeftToRight;
  FShadowThick:=2;
end;

destructor TArrow.Destroy;
begin
  inherited;
end;


procedure TArrow.SetDirection(Value:TDirection);
begin
  FDirection:=Value;
  RePaint;
end;

procedure TArrow.SetShadowThick(Value:integer);
begin
  if Value<0 then FShadowThick:=0
  else if Value>6 then FShadowThick:=6
    else  FShadowThick:=Value;
  RePaint;
end;

procedure TArrow.SetColor(Value:TColor);
begin
  FColor:=Value;
  RePaint;
end;

procedure TArrow.Paint;
  Procedure DrawAngle(X,Y,W,AngType:Integer;DColor:TColor);
  begin
    with Canvas do
    begin
      Brush.Color:=DColor;
      Pen.Color:=DColor;
      case AngType of
        1:Polygon([Point(X,Y), Point(X+W,Y-W), Point(X+W,Y+W)]);
        2:Polygon([Point(X,Y), Point(X-W,Y-W), Point(X-W,Y+W)]);
        3:Polygon([Point(X,Y), Point(X-W,Y+W), Point(X+W,Y+W)]);
        4:Polygon([Point(X,Y), Point(X-W,Y-W), Point(X+W,Y-W)]);
      end;
    end;
  end;
  Procedure DrawRect(X1,Y1,X2,Y2:integer;DColor:TColor);
  begin
    with Canvas do
    begin
      Brush.Color:=DColor;
      Pen.Color:=DColor;
      Polygon([Point(X1,Y1), Point(X2,Y1), Point(X2,Y2), Point(X1,Y2)]);
    end;
  end;
var
  ColorArray:array [0..7] of TColor;
  TempX1,TempX2,TempX3,TempY1,TempY2,TempY3:Integer;
  DrawW,DrawH:Integer;
  i:integer;
  clR,clG,ClB:integer;
begin
  ColorArray[0]:=FColor;
  ColorArray[1]:=RGB(0,0,0);
  if FShadowThick>0 then
  begin
    clR:=192 div (FShadowThick);
    clG:=192 div (FShadowThick);
    clB:=192 div (FShadowThick);
    for i:=2 to FShadowThick do
      ColorArray[i]:=RGB(clR*i,clG*i,clB*i);
  end;
  DrawW:=Width-FShadowThick-1;
  DrawH:=Height-FShadowThick-1;
  TempX1:=DrawW div 4;
  TempX2:=TempX1*2;
  TempX3:=TempX1*3;
  TempY1:=DrawH div 4;
  TempY2:=TempY1*2;
  TempY3:=TempY1*3;
  with inherited Canvas do
  begin
    Case FDirection of
      adLeftRight:
        begin
          for i:=ShadowThick Downto 0 do
            DrawRect(i,TempY1+i,DrawW+i,TempY3+i,ColorArray[i]);
        end;
      adLeftToRight:
        begin
          for i:=ShadowThick Downto 0 do
          begin
            DrawAngle(DrawW+i,TempY2+i,TempY2,2,ColorArray[i]);
            DrawRect(i,TempY1+i,DrawW-TempY2+i,TempY3+i,ColorArray[i]);
          end;
        end;
      adRightToLeft:
        begin
          for i:=ShadowThick Downto 0 do
          begin
            DrawAngle(i,TempY2+i,TempY2,1,ColorArray[i]);
            DrawRect(TempY2+i,TempY1+i,DrawW+i,TempY3+i,ColorArray[i]);
          end;
        end;
      adTopBottom:
        begin
          for i:=ShadowThick Downto 0 do
            DrawRect(TempX1+i,i,TempX3+i,DrawH+i,ColorArray[i]);
        end;
      adTopToBottom:
        begin
          for i:=ShadowThick Downto 0 do
          begin
            DrawAngle(TempX2+i,DrawH+i,TempX2,4,ColorArray[i]);
            DrawRect(TempX1+i,i,TempX3+i,DrawH-TempX2+i,ColorArray[i]);
          end;
        end;
      adBottomToTop:
        begin
          for i:=ShadowThick Downto 0 do
          begin
            DrawAngle(TempX2+i,i,TempX2,3,ColorArray[i]);
            DrawRect(TempX1+i,TempX2+i,TempX3+i,DrawH+i,ColorArray[i]);
          end;
        end;
    end;
  end;
end;

{TImgBtn}
procedure TImageBtn.WMSize(var message:TWMSize);
begin
  inherited;
  RePaint;
end;

constructor TImageBtn.Create;
begin
  inherited;
  Width:=80;
  Height:=30;
  FColor:=clWindowText;
  FFocuseColor:=clRed;
  FMOuseOnColor:=clBlue;
  FPushDownColor:=clWindowText;
  FFocused:=False;
  FPicture:=TPicture.Create;
  FMouseOnPic:=TPicture.Create;
  FPushDownPic:=TPicture.Create;
  FFocusePic:=TPicture.Create;
  FSpacing:=0;
  FLeftOffSet:=0;
  FTopOffSet:=0;
  FTransparent:=False;
  FTextLayout:=tlBottom;
  FTextStyle:=tsNone;
  FEnabled:=True;
  FPushDown:=False;
  FDownOffSet:=2;
  FFlat:=True;
end;

destructor TImageBtn.Destroy;
begin
  FPicture.Free;
  FMouseOnPic.Free;
  FPushDownPic.Free;
  FFocusePic.Free;
  inherited;
end;

procedure TImageBtn.SetCaption;
begin
  RePaint;
end;

procedure TImageBtn.SetFont;
begin
  (inherited canvas).Font.Assign(Font);
  FColor:=Font.Color;
  RePaint;
end;

procedure TImageBtn.SetColor(Value:TColor);
begin
  FColor:=value;
  RePaint;
end;