dfsclrbn.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsColorButton v2.61                                                        }
{------------------------------------------------------------------------------}
{ A Windows 95 and NT 4 style color selection button.  It displays a palette   }
{ of 20 color for fast selction and a button to bring up the color dialog.     }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TdfsColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See DFSClrBn.txt for notes, known issues, and revision history.              }
{------------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{------------------------------------------------------------------------------}


unit DFSClrBn;

interface

uses
  WinTypes, WinProcs, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
  Buttons, ExtCtrls, CBtnForm;


{$IFDEF DFS_WIN32}
  {$R DFSClrBn.res}
{$ELSE}
  {$R DFSClrBn.r16}
{$ENDIF}


{$IFDEF DFS_COMPILER_3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
  SOtherBtnCaption = '&Other';

const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TdfsColorButton v2.61';

type
  TdfsColorButton = class(TButton)
  private
    FShowColorHints: boolean;
    FOnGetColorHintText: TdfsColorHintTextEvent;
    FCurrentPaletteIndex: integer;
    FPaletteForm: TdfsColorButtonPalette;
    FSectionName: string;
    FOtherBtnCaption: string;
    FColorsLoaded: boolean;
    FCanvas: TCanvas;
    IsFocused: boolean;
    FStyle: TButtonStyle;
    FColor: TColor;
    FPaletteDisplayed: boolean;
    FCycleColors: boolean;
    FPaletteColors: TPaletteColors;
    FOtherColor: TColor;
    FCustomColors: TCustomColors;
    FIgnoreTopmosts: boolean;
{$IFDEF DFS_WIN32}
    FFlat: boolean;
    FCustomColorsKey: string;
{$ELSE}
    FCustomColorsINI: string;
{$ENDIF}
    FOnColorChange: TNotifyEvent;
    FArrowBmp: TBitmap;
    FDisabledArrowBmp: TBitmap;
    FIsMouseOver: boolean;
    FInhibitClick: boolean;

    procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
{$IFDEF DFS_WIN32}
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
{$ENDIF}

    procedure SetStyle(Value: TButtonStyle);
    procedure SetColor(Value: TColor);
    procedure SetPaletteColorIndex(Value: integer);
    procedure SetPaletteColors(Value: TPaletteColors);
    procedure SetCustomColors(Value: TCustomColors);
    procedure SetArrowBmp(Value: TBitmap);
    procedure SetDisabledArrowBmp(Value: TBitmap);
{$IFDEF DFS_WIN32}
    procedure SetFlat(Value: boolean);
{$ENDIF}

    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
    procedure PaletteSetColor(Sender: TObject; IsOther: boolean; AColor: TColor);
    procedure PaletteClosed(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Loaded; override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure SetDefaultColors; virtual;

    function GetSectionName: string; virtual;
    procedure SaveCustomColors; virtual;
    procedure LoadCustomColors; virtual;
    function GetVersion: string;
    procedure SetVersion(const Val: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
		procedure DoColorChange; virtual;

    property PaletteColorIndex: integer
       read FCurrentPaletteIndex
       write SetPaletteColorIndex;
    property ArrowBmp: TBitmap
       read FArrowBmp
       write SetArrowBmp;
    property DisabledArrowBmp: TBitmap
       read FDisabledArrowBmp
       write SetDisabledArrowBmp;
    property IgnoreTopmosts: boolean
       read FIgnoreTopmosts
       write FIgnoreTopmosts;
  published
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    property ShowColorHints: boolean
       read FShowColorHints
       write FShowColorHints
       default TRUE;
    property Style: TButtonStyle
       read FStyle
       write SetStyle
       default bsAutoDetect;
    property OtherBtnCaption: string
       read FOtherBtnCaption
       write FOtherBtnCaption;
    property OtherColor: TColor
       read FOtherColor
       write FOtherColor;
    property CycleColors: boolean
       read FCycleColors
       write FCycleColors
       default FALSE;
    property PaletteColors: TPaletteColors
       read FPaletteColors
       write SetPaletteColors
       stored TRUE;
    property CustomColors: TCustomColors
       read FCustomColors
       write SetCustomColors
       stored TRUE;
    { This property has to come after PaletteColors because it needs to use it }
    property Color: TColor
       read FColor
       write SetColor
       default clBlack;
{$IFDEF DFS_WIN32}
    property Flat: boolean
       read FFlat
       write SetFlat
       default FALSE;
    property CustomColorsKey: string
       read FCustomColorsKey
       write FCustomColorsKey;
{$ELSE}
    property CustomColorsINI: string
       read FCustomColorsINI
       write FCustomColorsINI;
{$ENDIF}
		property OnColorChange: TNotifyEvent
       read FOnColorChange
       write FOnColorChange;
    property OnGetColorHintText: TdfsColorHintTextEvent
       read FOnGetColorHintText
       write FOnGetColorHintText;
  end;

implementation

uses
  {$IFDEF DFS_WIN32}
  Registry,
  {$ELSE}
  IniFiles,
  {$ENDIF}
  SysUtils;


{$IFNDEF DFS_COMPILER_3_UP}
{ Delphi 1 & 2 don't have this, just fake it }
type
  TCustomForm = TForm;
{$ENDIF}

constructor TdfsColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIgnoreTopmosts := FALSE;
  FInhibitClick := FALSE;
  FShowColorHints := TRUE;
  FCurrentPaletteIndex := 0;
  FCycleColors := FALSE;
  FArrowBmp := TBitmap.Create;
  FDisabledArrowBmp := TBitmap.Create;
  { I had a report that the Handle assignment was failing for someone who had
    a large project, but that changing to LoadFromResource fixed it.
    Unfortunately, this isn't available in Delphi 1. }
  {$IFDEF DFS_WIN32}
  FArrowBmp.LoadFromResourceName(HInstance, 'DFS_ARROW_BMP');
  FDisabledArrowBmp.LoadFromResourceName(HInstance, 'DFS_ARROW_DISABLED_BMP');
  {$ELSE}
  FArrowBmp.Handle := LoadBitmap(HInstance, 'DFS_ARROW_BMP');
  FDisabledArrowBmp.Handle := LoadBitmap(HInstance, 'DFS_ARROW_DISABLED_BMP');
  {$ENDIF}
  FPaletteColors := TColorArrayClass.Create(4,5);
  FCustomColors := TColorArrayClass.Create(8,2);
  FPaletteForm := NIL;
  FOtherBtnCaption := SOtherBtnCaption;
  FColorsLoaded := FALSE;
  FCanvas := TCanvas.Create;
  FStyle := bsAutoDetect;
  FColor := clBlack;
  FPaletteDisplayed := FALSE;
  Caption := '';
  FIsMouseOver := FALSE;
  {$IFDEF DFS_DELPHI_3_UP}
  ControlStyle := ControlStyle + [csReflector];
  {$ENDIF}
  {$IFDEF DFS_WIN32}
  FFlat := FALSE;
  FCustomColorsKey := '';
  {$ELSE}
  FCustomColorsINI := '';
  {$ENDIF}
  SetDefaultColors;
  Width := 45;
  Height := 22;
end;

destructor TdfsColorButton.Destroy;
begin
  SaveCustomColors;
  FCanvas.Free;
  FPaletteColors.Free;
  FCustomColors.Free;
  FArrowBmp.Free;
  FDisabledArrowBmp.Free;
  inherited Destroy;
end;

procedure TdfsColorButton.CreateWnd;
begin
  inherited CreateWnd;

  if not FColorsLoaded then
    LoadCustomColors;
end;


procedure TdfsColorButton.Loaded;
begin
  inherited Loaded;

  LoadCustomColors;
end;


procedure TdfsColorButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style OR BS_OWNERDRAW;
end;

procedure TdfsColorButton.SetStyle(Value: TButtonStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Invalidate;
  end;