ezcolorpicker.pas

很管用的GIS控件

        finally
          free;
        end;
    end;

    //if FHoverIndex = -1 then HandleCustomColors(Message);
  end
  else EndSelection(True); // hide popup window if the user has clicked elsewhere
end;

//------------------------------------------------------------------------------

procedure TColorPopup.ShowPopupAligned;

var Pt: TPoint;
    Parent: TEzColorBox;
    ParentTop: Integer;
    R: TRect;
    H: Integer;

begin
  HandleNeeded;
  // hide the custem color picking area
  R := Rect(FWindowRect.Left, FWindowRect.Bottom - 3, FWindowRect.Right, FWindowRect.Bottom);
  H := FWindowRect.Bottom;
  // to ensure the window frame is drawn correctly we invalidate the lower bound explicitely
  InvalidateRect(Handle, @R, True);

  // Make sure the window is still entirely visible and aligned.
  // There's no VCL parent window as this popup is a child of the desktop,
  // but we have the owner and get the parent from this.
  Parent := TEzColorBox(Owner);
  Pt := Parent.Parent.ClientToScreen(Point(Parent.Left - 1, Parent.Top + Parent.Height));
  if (Pt.y + H) > Screen.Height then Pt.y := Screen.Height - H;
  ParentTop := Parent.Parent.ClientToScreen(Point(Parent.Left, Parent.Top)).y;
  if Pt.y  <  ParentTop then Pt.y := ParentTop - H;
  if (Pt.x + Width) > Screen.Width then Pt.x := Screen.Width - Width;
  if Pt.x < 0 then Pt.x := 0;
  SetWindowPos(Handle, HWND_TOPMOST, Pt.X, Pt.Y, FWindowRect.Right, H, SWP_SHOWWINDOW);
end;

//------------------------------------------------------------------------------

procedure TColorPopup.ChangeSelection(NewSelection: Integer);

begin
  if NewSelection <> NoCell then
  begin
    if FSelectedIndex <> NoCell then InvalidateCell(FSelectedIndex);
    FSelectedIndex := NewSelection;
    if FSelectedIndex <> NoCell then InvalidateCell(FSelectedIndex);

    if FSelectedIndex = CustomCell then ShowPopupAligned;
  end;
end;

//------------------------------------------------------------------------------

procedure TColorPopup.WMLButtonUp(var Message: TWMLButtonUp);

var NewSelection: Integer;

begin
  inherited;
  // determine new selection index
  NewSelection := SelectionFromPoint(Point(Message.XPos, Message.YPos));
  if NewSelection <> NoCell then
  begin
    ChangeSelection(NewSelection);
    if (FSelectedIndex <> NoCell) and
       (FSelectedIndex <> CustomCell) then EndSelection(False)
                                      else SetCapture(TEzColorBox(Owner).FPopupWnd);
  end
  else
    // we need to restore the mouse capturing, else the utility window will loose it
    // (safety feature of Windows?)
    SetCapture(TEzColorBox(Owner).FPopupWnd);
end;

//------------------------------------------------------------------------------

function TColorPopup.GetIndex(Row, Col: Integer): Integer;

begin
  Result := NoCell;
  if ((Row = CustomCell) or (Col = CustomCell)) and
     (Length(FCustomText) > 0) then Result := CustomCell
                                else
    if ((Row = NoneColorCell) or (Col = NoneColorCell)) and
        (Length(FNoneColorText) > 0) then Result := NoneColorCell
                                   else
      if (Col in [0..FColumnCount - 1]) and (Row >= 0) then
      begin

        if Row < FRowCount then
        begin
          Result := Row * FColumnCount + Col;
          // consider not fully filled last row
          if Result >= DefaultColorCount then Result := NoCell;
        end
        else
          if FShowSysColors then
          begin
            Dec(Row, FRowCount);
            if Row < FSysRowCount then
            begin
              Result := Row * FColumnCount + Col;
              // consider not fully filled last row
              if Result >= SysColorCount then Result := NoCell
                                         else Inc(Result, DefaultColorCount);
            end;
          end;
      end;
end;

//------------------------------------------------------------------------------

function TColorPopup.GetRow(Index: Integer): Integer;

begin
  if (Index = CustomCell) and (Length(FCustomText) > 0) then Result := CustomCell
                                                        else
    if (Index = NoneColorCell) and (Length(FNoneColorText) > 0 ) then Result := NoneColorCell
                                                             else Result := Index div FColumnCount;
end;

//------------------------------------------------------------------------------

function TColorPopup.GetColumn(Index: Integer): Integer;

begin
  if (Index = CustomCell) and (Length(FCustomText) > 0) then Result := CustomCell
                                                        else
    if (Index = NoneColorCell) and (Length(FNoneColorText) > 0 ) then Result := NoneColorCell
                                                             else Result := Index mod FColumnCount;
end;

//------------------------------------------------------------------------------

procedure TColorPopup.SelectColor(Color: TColor);

// looks up the given color in our lists and sets the proper indices

var I: Integer;
    C: COLORREF;
    found: Boolean;

begin
  found := False;

  // handle special colors first
    if Color = clNone then FSelectedIndex := NoneColorCell
                         else
    begin
      // if the incoming color is one of the predefined colors (clBtnFace etc.) and
      // system colors are active then start looking in the system color list
      if FShowSysColors and (Color < 0) then
      begin
        for I := 0 to SysColorCount - 1 do
          if TColor(SysColors[I].Color) = Color then
          begin
            FSelectedIndex := I + DefaultColorCount;
            found := True;
            Break;
          end;
      end;

      if not found then
      begin
        C := ColorToRGB(Color);
        for I := 0 to DefaultColorCount - 1 do
          // only Borland knows why the result of ColorToRGB is Longint not COLORREF,
          // in order to make the compiler quiet I need a Longint cast here
          if ColorToRGB(DefaultColors[I].Color) = Longint(C) then
          begin
            FSelectedIndex := I;
            found := True;
            Break;
          end;

        // look in the system colors if not already done yet
        if not found and FShowSysColors and (Color >= 0) then
        begin
          for I := 0 to SysColorCount - 1 do
          begin
            if ColorToRGB(TColor(SysColors[I].Color)) = Longint(C) then
            begin
              FSelectedIndex := I + DefaultColorCount;
              found := True;
              Break;
            end;
          end;
        end;

        if not found then
        begin
          FSelectedIndex := CustomCell;
          FCustomColor:= Color;
        end;
      end;
    end;
end;

//------------------------------------------------------------------------------

function TColorPopup.GetCellRect(Index: Integer; var Rect: TRect): Boolean;

// gets the dimensions of the colour cell given by Index

begin
  Result := False;
  if Index = CustomCell then
  begin
    Rect := FCustomTextRect;
    Result := True;
  end
  else
    if Index = NoneColorCell then
    begin
      Rect := FNoneColorTextRect;
      Result := True;
    end
    else
      if Index >= 0 then
      begin
        Rect.Left := GetColumn(Index) * FBoxSize + FMargin + FSpacing;
        Rect.Top := GetRow(Index) * FBoxSize + 2 * FMargin;

        // move everything down if we are displaying a default text area
        if Length(FNoneColorText) > 0 then Inc(Rect.Top, FNoneColorTextRect.Bottom - 2 * FMargin);

        // move everything further down if we consider syscolors
        if Index >= DefaultColorCount then Inc(Rect.Top, 3 * FMargin);

        Rect.Right := Rect.Left + FBoxSize;
        Rect.Bottom := Rect.Top + FBoxSize;

        Result := True;
      end;
end;

//------------------------------------------------------------------------------

procedure TColorPopup.AdjustWindow;

// works out an appropriate size and position of this window

var TextSize,
    DefaultSize: TSize;
    DC: HDC;
    WHeight: Integer;

begin
  // If we are showing a custom or default text area, get the font and text size.
  if (Length(FCustomText) > 0) or (Length(FNoneColorText) > 0) then
  begin
    DC := GetDC(Handle);
    FCanvas.Handle := DC;
    FCanvas.Font.Handle := GetStockObject(DEFAULT_GUI_FONT);
    try
      // Get the size of the custom text (if there IS custom text)
      TextSize.cx := 0;
      TextSize.cy := 0;
      if Length(FCustomText) > 0 then TextSize := FCanvas.TextExtent(FCustomText);

      // Get the size of the default text (if there IS default text)
      if Length(FNoneColorText) > 0 then
      begin
        DefaultSize := FCanvas.TextExtent(FNoneColorText);
        if DefaultSize.cx > TextSize.cx then TextSize.cx := DefaultSize.cx;
        if DefaultSize.cy > TextSize.cy then TextSize.cy := DefaultSize.cy;
      end;

      Inc(TextSize.cx, 2 * FMargin);
      Inc(TextSize.cy, 4 * FMargin + 2);

    finally
      FCanvas.Font.Handle := 0;
      FCanvas.Handle := 0;
      ReleaseDC(Handle, DC);
    end;
  end;

  // Get the number of columns and rows
  FColumnCount := 8;
  FRowCount := DefaultColorCount div FColumnCount;
  if (DefaultColorCount mod FColumnCount) <> 0 then Inc(FRowCount);

  FWindowRect := Rect(0, 0,
                      FColumnCount * FBoxSize + 2 * FMargin + 2 * FSpacing,
                      FRowCount * FBoxSize + 4 * FMargin);

  // if default text, then expand window if necessary, and set text width as
  // window width
  if Length(FNoneColorText) > 0 then
  begin
    if TextSize.cx > (FWindowRect.Right - FWindowRect.Left) then FWindowRect.Right := FWindowRect.Left + TextSize.cx;
    TextSize.cx := FWindowRect.Right - FWindowRect.Left - 2 * FMargin;

    // work out the text area
    FNoneColorTextRect := Rect(FMargin + FSpacing, 2 * FMargin, FMargin -FSpacing + TextSize.cx, 2 * FMargin + TextSize.cy);
    Inc(FWindowRect.Bottom, FNoneColorTextRect.Bottom - FNoneColorTextRect.Top + 2 * FMargin);
  end;

  if FShowSysColors then
  begin
    FSysRowCount := SysColorCount div FColumnCount;
    if (SysColorCount mod FColumnCount) <> 0 then Inc(FSysRowCount);
    Inc(FWindowRect.Bottom, FSysRowCount * FBoxSize + 2 * FMargin);
  end;

  // if custom text, then expand window if necessary, and set text width as
  // window width
  if Length(FCustomText) > 0 then
  begin
    if TextSize.cx > (FWindowRect.Right - FWindowRect.Left) then FWindowRect.Right := FWindowRect.Left + TextSize.cx;
    TextSize.cx := FWindowRect.Right - FWindowRect.Left - 2 * FMargin;

    // work out the text area
    WHeight := FWindowRect.Bottom - FWindowRect.Top;
    FCustomTextRect := Rect(FMargin + FSpacing,
                            WHeight,
                            FMargin - FSpacing + TextSize.cx,
                            WHeight + TextSize.cy);
    // precalculate also the small preview box for custom color selection for fast updates
    FCustomColorRect := Rect(0, 0, FBoxSize, FBoxSize);
    InflateRect(FCustomColorRect, -(FMargin + 1), -(FMargin + 1));
    OffsetRect(FCustomColorRect,
               FCustomTextRect.Right - FBoxSize - FMargin,
               FCustomTextRect.Top + (FCustomTextRect.Bottom - FCustomTextRect.Top - FCustomColorRect.Bottom - FMargin - 1) div 2);

    Inc(FWindowRect.Bottom, FCustomTextRect.Bottom - FCustomTextRect.Top + 2 * FMargin);
  end;

  // set the window size
  with FWindowRect do SetBounds(Left, Top, Right - Left, Bottom - Top);
end;

//------------------------------------------------------------------------------

procedure TColorPopup.ChangeHoverSelection(Index: Integer);

begin
  if not FShowSysColors and (Index >= DefaultColorCount) or
     (Index >= (DefaultColorCount + SysColorCount)) then Index := NoCell;

  // remove old hover selection
  InvalidateCell(FHoverIndex);

  FHoverIndex := Index;
  InvalidateCell(FHoverIndex);
  UpdateWindow(Handle);
end;

//------------------------------------------------------------------------------

procedure TColorPopup.EndSelection(Cancel: Boolean);

begin
  with Owner as TEzColorBox do
  begin
    if not Cancel then
    begin
      if FSelectedIndex > -1 then
        if FSelectedIndex < DefaultColorCount then SelectionColor := TColor(DefaultColors[FSelectedIndex].Color)
                                              else SelectionColor := TColor(SysColors[FSelectedIndex - DefaultColorCount].Color)
                             else
        if FSelectedIndex = CustomCell then
        begin
          SelectionColor:= FCustomColor;
        end
        else DoNoneColorEvent;
    end;
    DroppedDown := False;
  end;
end;

//------------------------------------------------------------------------------

procedure TColorPopup.WMKillFocus(var Message: TWMKillFocus);

begin
  inherited;
  (Owner as TEzColorBox).DroppedDown := False;
end;

//------------------------