ezcolorpicker.pas

很管用的GIS控件

begin
  if Assigned(FOriginal) then
  begin
    if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;

    Index := CreateButtonGlyph(State);

    with GlyphPos do
      if Transparent or (State = bsExclusive) then
        ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0, clNone, clNone, ILD_Transparent)
      else
        ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0, ColorToRGB(clBtnFace), clNone, ILD_Normal);
  end;
end;

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

procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
                                      TextBounds: TRect; State: TButtonState;
                                      BiDiFlags: Longint);

begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    if State = bsDisabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags);
    end
    else
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags);
  end;
end;

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

procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
            const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
            Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
            const DropDownWidth: Integer; BiDiFlags: Longint);

var TextPos: TPoint;
    ClientSize,
    GlyphSize,
    TextSize: TPoint;
    TotalSize: TPoint;

begin
  if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
    if Layout = blGlyphLeft then Layout := blGlyphRight
                            else
      if Layout = blGlyphRight then Layout := blGlyphLeft;
      
  // calculate the item sizes
  ClientSize := Point(Client.Right - Client.Left - DropDownWidth, Client.Bottom - Client.Top);

  if FOriginal <> nil then GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height)
                      else GlyphSize := Point(0, 0);

  if Length(Caption) > 0 then
  begin
    TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top);
  end
  else
  begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  // If the layout has the glyph on the right or the left, then both the
  // text and the glyph are centered vertically.  If the glyph is on the top
  // or the bottom, then both the text and the glyph are centered horizontally.
  if Layout in [blGlyphLeft, blGlyphRight] then
  begin
    GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else
  begin
    GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  end;

  // if there is no text or no bitmap, then Spacing is irrelevant
  if (TextSize.X = 0) or (GlyphSize.X = 0) then Spacing := 0;

  // adjust Margin and Spacing
  if Margin = -1 then
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then Margin := (ClientSize.X - TotalSize.X) div 3
                                               else Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else
    begin
      TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then Margin := (ClientSize.X - TotalSize.X + 1) div 2
                                               else Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
      if Layout in [blGlyphLeft, blGlyphRight] then Spacing := (TotalSize.X - TextSize.X) div 2
                                               else Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;

  case Layout of
    blGlyphLeft:
      begin
        GlyphPos.X := Margin;
        TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
      end;
    blGlyphRight:
      begin
        GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
        TextPos.X := GlyphPos.X - Spacing - TextSize.X;
      end;
    blGlyphTop:
      begin
        GlyphPos.Y := Margin;
        TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
      end;
    blGlyphBottom:
      begin
        GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
        TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
      end;
  end;

  // fixup the result variables
  with GlyphPos do
  begin
    Inc(X, Client.Left + Offset.X);
    Inc(Y, Client.Top + Offset.Y);
  end;
  OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.X);
end;

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

function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
           const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
           Margin, Spacing: Integer; State: TButtonState; Transparent: Boolean;
           const DropDownWidth: Integer; BiDiFlags: Longint): TRect;

var GlyphPos: TPoint;
    R: TRect;

begin
  CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing, GlyphPos, R, DropDownWidth, BidiFlags);
  DrawButtonGlyph(Canvas, GlyphPos, State, Transparent);
  DrawButtonText(Canvas, Caption, R, State, BiDiFlags);

  // return a rectangle wherein the color indicator can be drawn
  if Caption = '' then
  begin
    Result := Client;
    Dec(Result.Right, DropDownWidth + 2);
    InflateRect(Result, -2, -2);

    // consider glyph if no text is to be painted (else it is already taken into account)
    if Assigned(FOriginal) and (FOriginal.Width > 0) and (FOriginal.Height > 0) then
      case Layout of
        blGlyphLeft:
          begin
            Result.Left := GlyphPos.X + FOriginal.Width + 4;
            Result.Top := GlyphPos.Y;
            Result.Bottom := GlyphPos.Y + FOriginal.Height;
          end;
        blGlyphRight:
          begin
            Result.Right := GlyphPos.X - 4;
            Result.Top := GlyphPos.Y;
            Result.Bottom := GlyphPos.Y + FOriginal.Height;
          end;
        blGlyphTop:
            Result.Top := GlyphPos.Y + FOriginal.Height + 4;
        blGlyphBottom:
            Result.Bottom := GlyphPos.Y - 4;
      end;
  end
  else
  begin
    // consider caption
    Result := Rect(R.Left, R.Bottom, R.Right, R.Bottom + 6);
    if (Result.Bottom + 2) > Client.Bottom then Result.Bottom := Client.Bottom - 2;
  end;
end;

//----------------- TColorPopup ------------------------------------------------

constructor TColorPopup.Create(AOwner: TComponent);

begin
  inherited;
  ControlStyle := ControlStyle + [csNoDesignVisible, csOpaque] - [csAcceptsControls];
  Visible:= False;
  FCanvas := TCanvas.Create;
  Color := clBtnFace;
  ShowHint := True;

  Initialise;
end;

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

procedure TColorPopup.Initialise;
begin
  FBoxSize := 20;
  FMargin := GetSystemMetrics(SM_CXEDGE);
  FSpacing := 8;
  FHoverIndex := NoCell;
  FSelectedIndex := NoCell;

end;

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

destructor TColorPopup.Destroy;

begin
  FCanvas.Free;
  inherited;
end;

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

procedure TColorPopup.CNSysKeyDown(var Message: TWMKeyDown);

// handles accelerator keys

begin
  with Message do
  begin
    if (Length(FNoneColorText) > 0) and IsAccel(CharCode, FNoneColorText) then
    begin
      ChangeSelection(NoneColorCell);
      EndSelection(False);
      Result := 1;
    end
    else
      if (FSelectedIndex <> CustomCell) and
         (Length(FCustomText) > 0) and
         IsAccel(CharCode, FCustomText) then
      begin
        ChangeSelection(CustomCell);
        Result := 1;
      end
      else inherited;
    end;
end;

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

procedure TColorPopup.CNKeyDown(var Message: TWMKeyDown);

// if an arrow key is pressed, then move the selection

var Row,
    MaxRow,
    Column: Integer;

begin
  inherited;

  if FHoverIndex <> NoCell then
  begin
    Row := GetRow(FHoverIndex);
    Column := GetColumn(FHoverIndex);
  end
  else
  begin
    Row := GetRow(FSelectedIndex);
    Column := GetColumn(FSelectedIndex);
  end;

  if FShowSysColors then MaxRow := DefaultColorCount + SysColorCount - 1
                    else MaxRow := DefaultColorCount - 1;

  case Message.CharCode of
    VK_DOWN:
      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
          begin
            Inc(Row);
            if GetIndex(Row, Column) < 0 then
            begin
              if Length(FCustomText) > 0 then
              begin
                Row := CustomCell;
                Column := Row;
              end
              else
              begin
                if Length(FNoneColorText) > 0 then
                begin
                  Row := NoneColorCell;
                  Column := Row;
                end
                else
                begin
                  Row := 0;
                  Column := 0;
                end;
              end;
            end;
          end;
        ChangeHoverSelection(GetIndex(Row, Column));
        Message.Result := 1;
      end;

    VK_UP:
      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 Row > 0 then Dec(Row)
                       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;
        ChangeHoverSelection(GetIndex(Row, Column));