ezcolorpicker.pas

很管用的GIS控件

        Message.Result := 1;
      end;

    VK_RIGHT:
      begin
        if Row = NoneColorCell then
        begin
          Row := 0;
          Column := 0;
        end
        else
          if Row = CustomCell then
          begin
            if Length(FNoneColorText) > 0 then
            begin
              Row := NoneColorCell;
              Column := Row;
            end
            else
            begin
              Row := 0;
              Column := 0;
            end;
          end
          else
            if Column < FColumnCount - 1 then Inc(Column)
                                            else
            begin
              Column := 0;
              Inc(Row);
            end;

          if GetIndex(Row, Column) = NoCell then
          begin
            if Length(FCustomText) > 0 then
            begin
              Row := CustomCell;
              Column := Row;
            end
            else
              if Length(FNoneColorText) > 0 then
              begin
                Row := NoneColorCell;
                Column := Row;
              end
              else
              begin
                Row := 0;
                Column := 0;
              end;
          end;
        ChangeHoverSelection(GetIndex(row, Column));
        Message.Result := 1;
      end;

    VK_LEFT:
      begin
        if Row = NoneColorCell then
        begin
          if Length(FCustomText) > 0 then
          begin
            Row := CustomCell;
            Column := Row;
          end
          else
          begin
            Row := GetRow(MaxRow);
            Column := GetColumn(MaxRow);
          end;
        end
        else
          if Row = CustomCell then
          begin
            Row := GetRow(MaxRow);
            Column := GetColumn(MaxRow);
          end
          else
            if Column > 0 then Dec(Column)
                          else
            begin
              if Row > 0 then
              begin
                Dec(Row);
                Column := FColumnCount - 1;
              end
              else
              begin
                if Length(FNoneColorText) > 0 then
                begin
                  Row := NoneColorCell;
                  Column := Row;
                end
                else
                  if Length(FCustomText) > 0 then
                  begin
                    Row := CustomCell;
                    Column := Row;
                  end
                  else
                  begin
                    Row := GetRow(MaxRow);
                    Column := GetColumn(MaxRow);
                  end;
              end;
            end;
        ChangeHoverSelection(GetIndex(Row, Column));
        Message.Result := 1;
      end;

    VK_ESCAPE:
      begin
        EndSelection(True);
        Message.Result := 1;
      end;

    VK_RETURN,
    VK_SPACE:
      begin
        // this case can only occur if there was no click on the window
        // hence the hover index is the new color
        FSelectedIndex := FHoverIndex;
        EndSelection(False);
        Message.Result := 1;
      end;
  end;
end;

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

procedure TColorPopup.DrawSeparator(Left, Top, Right: Integer);

var R: TRect;

begin
  R := Rect(Left, Top, Right, Top);
  DrawEdge(FCanvas.Handle, R, EDGE_ETCHED, BF_TOP);
end;

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

procedure TColorPopup.DrawCell(Index: Integer);

var R, MarkRect: TRect;
    CellColor: TColor;

begin
  // for the custom text area
  if (Length(FCustomText) > 0) and (Index = CustomCell) then
  begin
    // the extent of the actual text button
    R := FCustomTextRect;

    // fill background
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.FillRect(R);

    with FCustomTextRect do DrawSeparator(Left, Top - 2 * FMargin, Right);

    InflateRect(R, -1, 0);

    // fill background
    if (FSelectedIndex = Index) and (FHoverIndex <> Index) then FCanvas.Brush.Color := clBtnHighlight
                                                           else FCanvas.Brush.Color := clBtnFace;

    FCanvas.FillRect(R);
    // draw button
    if (FSelectedIndex = Index) or
       ((FHoverIndex = Index) and (csLButtonDown in ControlState)) then DrawEdge(FCanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT)
                                                                   else
      if FHoverIndex = Index then DrawEdge(FCanvas.Handle, R, BDR_RAISEDINNER, BF_RECT);

    // draw custom text
    SetBkMode(FCanvas.Handle, TRANSPARENT);
    DrawText(FCanvas.Handle, PChar(FCustomText), Length(FCustomText), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);

    // draw preview color rectangle
    If FSelectedIndex= CustomCell then
    begin
      FCanvas.Pen.Color := clGray;
      FCanvas.Brush.Color := FCustomColor;
      with FCustomColorRect do
        FCanvas.Rectangle(Left, Top, Right, Bottom);
    end else
    begin
      FCanvas.Brush.Color := clBtnShadow;
      FCanvas.FrameRect(FCustomColorRect);
    end;
  end
  else
    // for the default text area
    if (Length(FNoneColorText) > 0) and (Index = NoneColorCell) then
    begin
      R := FNoneColorTextRect;

      // Fill background
      FCanvas.Brush.Color := clBtnFace;
      FCanvas.FillRect(R);

      InflateRect(R, -1, -1);

      // fill background
      if (FSelectedIndex = Index) and (FHoverIndex <> Index) then FCanvas.Brush.Color := clBtnHighlight
                                                             else FCanvas.Brush.Color := clBtnFace;

      FCanvas.FillRect(R);
      // draw button
      if (FSelectedIndex = Index) or
         ((FHoverIndex = Index) and (csLButtonDown in ControlState)) then
        DrawEdge(FCanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT)
      else if FHoverIndex = Index then
        DrawEdge(FCanvas.Handle, R, BDR_RAISEDINNER, BF_RECT);

      // draw small rectangle
      with MarkRect do
      begin
        MarkRect := R;
        InflateRect(MarkRect, -FMargin - 1, -FMargin - 1);
        FCanvas.Brush.Color := clBtnShadow;
        FCanvas.FrameRect(MarkRect);
      end;

      // draw default text
      SetBkMode(FCanvas.Handle, TRANSPARENT);
      DrawText(FCanvas.Handle, PChar(FNoneColorText), Length(FNoneColorText), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    end
    else
    begin
      if GetCellRect(Index, R) then
      begin
        if Index < DefaultColorCount then CellColor := TColor(DefaultColors[Index].Color)
                                     else CellColor := TColor(SysColors[Index - DefaultColorCount].Color);
        FCanvas.Pen.Color := clGray;
        // fill background
        if (FSelectedIndex = Index) and (FHoverIndex <> Index) then FCanvas.Brush.Color := clBtnHighlight
                                                               else FCanvas.Brush.Color := clBtnFace;
        FCanvas.FillRect(R);

        // draw button
        if (FSelectedIndex = Index) or
           ((FHoverIndex = Index) and (csLButtonDown in ControlState)) then DrawEdge(FCanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT)
                                                                       else
          if FHoverIndex = Index then DrawEdge(FCanvas.Handle, R, BDR_RAISEDINNER, BF_RECT);

        FCanvas.Brush.Color := CellColor;

        // draw the cell colour
        InflateRect(R, -(FMargin + 1), -(FMargin + 1));
        FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      end;
    end;
end;

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

procedure TColorPopup.WMPaint(var Message: TWMPaint);

var PS: TPaintStruct;
    I: Cardinal;
    R: TRect;
    SeparatorTop: Integer;

begin
  if Message.DC = 0 then FCanvas.Handle := BeginPaint(Handle, PS)
                    else FCanvas.Handle := Message.DC;
  try
    // use system default font for popup text
    FCanvas.Font.Handle := GetStockObject(DEFAULT_GUI_FONT);

    // default area text
    if Length(FNoneColorText) > 0 then DrawCell(NoneColorCell);

    // Draw colour cells
    for I := 0 to DefaultColorCount - 1 do DrawCell(I);

    if FShowSysColors then
    begin
      SeparatorTop := FRowCount * FBoxSize + FMargin;
      if Length(FNoneColorText) > 0 then Inc(SeparatorTop, FNoneColorTextRect.Bottom);
      with FCustomTextRect do DrawSeparator(FMargin + FSpacing, SeparatorTop, Width - FMargin - FSpacing);

      for I := 0 to SysColorCount - 1 do DrawCell(I + DefaultColorCount);
    end;

    // Draw custom text
    if Length(FCustomText) > 0 then DrawCell(CustomCell);

    // draw raised window edge (ex-window style WS_EX_WINDOWEDGE is supposed to do this,
    // but for some reason doesn't paint it)
    R := ClientRect;
    DrawEdge(FCanvas.Handle, R, EDGE_RAISED, BF_RECT);
  finally
    FCanvas.Font.Handle := 0; // a stock object never needs to be freed
    FCanvas.Handle := 0;
    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
end;

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

function TColorPopup.SelectionFromPoint(P: TPoint): Integer;

// determines the button at the given position

begin
  Result := NoCell;

  // first check we aren't in text box
  if (Length(FCustomText) > 0) and PtInRect(FCustomTextRect, P) then Result := CustomCell
                                                                else
    if (Length(FNoneColorText) > 0) and PtInRect(FNoneColorTextRect, P) then Result := NoneColorCell
                                                                    else
    begin
      // take into account text box
      if Length(FNoneColorText) > 0 then Dec(P.Y, FNoneColorTextRect.Bottom - FNoneColorTextRect.Top);

      // Get the row and column
      if P.X > FSpacing then
      begin
        Dec(P.X, FSpacing);
        // take the margin into account, 2 * FMargin is too small while 3 * FMargin
        // is correct, but looks a bit strange (the arrow corner is so small, it isn't
        // really recognized by the eye) hence I took 2.5 * FMargin
        Dec(P.Y, 5 * FMargin div 2);
        if (P.X >= 0) and (P.Y >= 0) then
        begin
          // consider system colors
          if FShowSysColors and ((P.Y div FBoxSize) >= FRowCount) then
          begin
            // here we know the point is out of the default color area, so
            // take the separator line between default and system colors into account
            Dec(P.Y, 3 * FMargin);
            // if we now are back in the default area then the point was originally
            // between both areas and we have therefore to reject a hit
            if (P.Y div FBoxSize) < FRowCount then Exit;
          end;
          Result := GetIndex(P.Y div FBoxSize, P.X div FBoxSize);
        end;
      end;
  end;
end;

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

procedure TColorPopup.WMMouseMove(var Message: TWMMouseMove);

var NewSelection: Integer;

begin
  inherited;
  // determine new hover index
  NewSelection := SelectionFromPoint(Point(Message.XPos, Message.YPos));

  if NewSelection <> FHoverIndex then ChangeHoverSelection(NewSelection);
end;

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

procedure TColorPopup.WMLButtonDown(var Message: TWMLButtonDown);
var
  AParent: TEzColorBox;
begin
  inherited;

  if PtInRect(ClientRect, Point(Message.XPos, Message.YPos)) then
  begin

    if FHoverIndex <> NoCell then
    begin
      InvalidateCell(FHoverIndex);
      UpdateWindow(Handle);
    end;

    if FHoverIndex = -3 then
    begin
      AParent:= TEzColorBox(Owner);
      AParent.SelectionColor:= clNone;
    end;

    if FHoverIndex = -2 then
    begin
      AParent:= TEzColorBox(Owner);
      AParent.DroppedDown:=False;
      with TColorDialog.Create(Nil) do
        try
          Options:= [cdFullOpen];
          Color:= AParent.SelectionColor;
          if Execute then
            AParent.SelectionColor:= Color;