jvqcolorcombo.pas

East make Tray Icon in delphi

procedure TJvColorComboBox.GetCustomColors(AList: TList);
var
  I, J: Integer;
begin
  if AList = nil then
    Exit;
  J := Ord((coCustomColors in Options));
  for I := Items.Count - (CustomColorCount + J) to pred(Items.Count - J) do
    AList.Add(Items.Objects[I]);
end;

procedure TJvColorComboBox.InternalInsertColor(AIndex: Integer;
  AColor: TColor; const DisplayName: string);
begin
  Items.InsertObject(AIndex, DisplayName, TObject(AColor));
end;

procedure TJvColorComboBox.DoNameMapChange(Sender: TObject);
begin
  Invalidate;
end;

//=== { TJvFontComboBox } ====================================================

constructor TJvFontComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTrueTypeBmp := LoadInternalBitmap('JvFontComboBoxTTF');
  FFixBmp := LoadInternalBitmap('JvFontComboBoxFIX');
  FHiliteColor := clHighlight;
  FHiliteText := clHighlightText;
  FUseImages := True;
  Style := csOwnerDrawFixed;
  AutoComplete := False;
  ResetItemHeight;
end;

destructor TJvFontComboBox.Destroy;
begin
  FTrueTypeBmp.Free;
  FFixBmp.Free;
  inherited Destroy;
end;

procedure TJvFontComboBox.GetFonts;
var
  MRUItems: TStringList;
  I: Integer;
  FontType: integer;
begin
  HandleNeeded;
  if not HandleAllocated then
    Exit;
  MRUItems := TStringList.Create;
  try
    if FShowMRU then
      for I := 0 to MRUCount - 1 do
        MRUItems.AddObject(Items[I], Items.Objects[I]);
    Clear;
    For I:= 0 to Screen.Fonts.Count - 1 do
    begin
      FontType := GetFontType(Screen.Fonts[I]);
      if IncludeFont(Options, Screen.Fonts[I], FontType) then
        Items.AddObject(Screen.Fonts[I], TObject(FontType));
    end;
    if FShowMRU then
      for I := MRUCount - 1 downto 0 do
      begin
        Items.InsertObject(0, MRUItems[I], MRUItems.Objects[I]);
      end;
  finally
    MRUItems.Free;
  end;
end;

procedure TJvFontComboBox.SetOptions(Value: TJvFontComboOptions);
begin
  if Value <> Options then
  begin
    FOptions := Value;
    if (foPreviewFont in FOptions) then
      Exclude(FOptions, foWysiWyg);
    SetShowMRU(foMRU in FOptions);
    Reset;
  end;
end;

procedure TJvFontComboBox.SetUseImages(Value: Boolean);
begin
  if FUseImages <> Value then
  begin
    FUseImages := Value;
    Invalidate;
  end;
end;

function TJvFontComboBox.DoDrawPreview(const AFontName: string;
  var APreviewText: string; ATextWidth: Integer): Boolean;
begin
  Result := ATextWidth < ClientWidth;
  if Assigned(FOnDrawPreviewEvent) then
    FOnDrawPreviewEvent(Self, AFontName, APreviewText, ATextWidth, Result);
end;

function TJvFontComboBox.DrawItem(Index: Integer; R: TRect;
  State: TOwnerDrawState): boolean;
var
  ABmp: TBitmap;
  AColor: TColor;
  AWidth: Integer;
  TmpRect: TRect;
  S, AName: string;
begin
  Result := True;
  if (Index >= 0) and (odSelected in State) then
  begin
    Canvas.Brush.Color := FHiliteColor;
    Canvas.Font.Color := FHiliteText;
  end;
  R.Bottom := R.Top + ItemHeight;
  if Index < 0 then
    Canvas.FillRect(R)
  else
  with Canvas do
  begin
    AColor := Brush.Color;
    Brush.Color := Color;
    Pen.Color := Font.Color;
    FillRect(R);
    Inc(R.Top);
    //    AWidth  := 20;
    if (Integer(Items.Objects[Index]) and TRUETYPE_FONTTYPE) <> 0 then
      ABmp := FTrueTypeBmp
    else
      ABmp := FFixBmp;
    if not FUseImages then
      ABmp := nil;

    if ABmp <> nil then
    begin
      AWidth := ABmp.Width;
      Draw(R.Left + 2, (R.Top + R.Bottom - ABmp.Height) div 2, ABmp);
      R.Left := R.Left + AWidth + 6;
    end
    else
      AWidth := 4;
    Brush.Color := AColor;
    AName := Canvas.Font.Name;
    if foWysiWyg in FOptions then
    begin
      if (foPreviewFont in Options) then
        Canvas.Font.Name := Self.Font.Name
      else
        Canvas.Font.Name := Items[Index];
    end;
    if not (foPreviewFont in Options) then
      R.Right := R.Left + TextWidth(Items[Index]) + 6;
    FillRect(R);
    OffsetRect(R, 2, 0);
    DrawText(Canvas, Items[Index], -1, R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
    if (foPreviewFont in Options) then
    begin
      Inc(AWidth, TextWidth(Items[Index]) + 36);
      Canvas.Font.Name := Items[Index];
      S := 'AbCdEfGhIj';
      Inc(AWidth, TextWidth(S));
      if DoDrawPreview(Items[Index], S, AWidth) then
      begin
        TmpRect := R;
        TmpRect.Left := 0;
        TmpRect.Right := ClientWidth - (GetSystemMetrics(SM_CXVSCROLL) + 8);
        R.Right := ClientWidth;
        DrawText(Canvas, S, -1, TmpRect, DT_SINGLELINE or DT_VCENTER or DT_RIGHT or DT_NOPREFIX);
      end;
    end;
    Canvas.Font.Name := AName;
    OffsetRect(R, -2, 0);
    if odSelected in State then
      DrawFocusRect(R);
    if FShowMRU and not (odComboBoxEdit in State) then
    begin
      // draw MRU separator
      Dec(R.Top);
      if (Index = MRUCount - 1) then
      begin
        Canvas.Pen.Color := clGray;
        Canvas.Pen.Width := 1;
        Canvas.MoveTo(0, R.Bottom - 1);
        Canvas.LineTo(ClientWidth, R.Bottom - 1);
      end
      else
      if (Index = MRUCount) and (Index > 0) then
      begin
        Canvas.Pen.Color := clGray;
        Canvas.Pen.Width := 1;
        Canvas.MoveTo(0, R.Top + 1);
        Canvas.LineTo(ClientWidth, R.Top + 1);
      end;
    end;
  end;
end;

procedure TJvFontComboBox.FontChanged;
begin
  ResetItemHeight;
  inherited FontChanged;
end;

procedure TJvFontComboBox.ResetItemHeight;
begin
  if not (csRecreating in ControlState) then
    ItemHeight := Max(GetItemHeight(Font), FTrueTypeBmp.Height + 2);
end;

procedure TJvFontComboBox.Click;
begin
  inherited Click;
  Change;
  if FShowMRU and FWasMouse and not DroppedDown then
  begin
    ItemIndex := AddToMRU;
    FWasMouse := False;
  end;
end;

procedure TJvFontComboBox.Reset;
var
  S: string;
begin
  HandleNeeded;
  if HandleAllocated then
  begin
    S := FontName;
    GetFonts;
    ResetItemHeight;
    if S <> '' then
      FontName := S
    else
      FontName := Font.Name;
  end;
end;

function TJvFontComboBox.GetFontName: string;
begin
  Result := inherited Text;
end;

procedure TJvFontComboBox.SetFontName(const Value: string);
begin
  HandleNeeded;
  if HandleAllocated and (Value <> '') then
  begin
    if Items.Count = 0 then
      GetFonts;
    ItemIndex := Items.IndexOf(Value);
    if ItemIndex = -1 then // try to find the font substitute name
      ItemIndex := Items.IndexOf(FontSubstitute(Value));
    if (ItemIndex = -1) and (foDisableVerify in Options) then // add if allowed to
      ItemIndex := Items.AddObject(Value, TObject(TRUETYPE_FONTTYPE));
  end;
end;

procedure TJvFontComboBox.Loaded;
begin
  inherited Loaded;
//  HandleNeeded;
  Reset;
  FontChanged;
end;

function TJvFontComboBox.GetSorted: Boolean;
begin
  Result := inherited Sorted;
end;

procedure TJvFontComboBox.SetSorted(const Value: Boolean);
var
  S: string;
begin
  if Value <> inherited Sorted then
  begin
    S := FontName;
    if not FShowMRU then
      inherited Sorted := Value
    else
      inherited Sorted := False;
    FontName := S;
  end;
end;

function TJvFontComboBox.FontSubstitute(const AFontName: string): string;
{$IFDEF MSWINDOWS}
var
  aSize: DWORD;
  AKey: HKey;
begin
  Result := AFontName;
  if AFontName = '' then Exit;
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar('SOFTWARE\Microsoft\Windows NT\CurrentVersion\FontSubstitutes'), 0,
    KEY_QUERY_VALUE, AKey) = ERROR_SUCCESS then
  try
    if (RegQueryValueEx(AKey, PChar(AFontName),
      nil, nil, nil, @aSize) = ERROR_SUCCESS) and (aSize > 0) then
    begin
      SetLength(Result, aSize);
      if RegQueryValueEx(AKey, PChar(AFontName), nil, nil, PByte(@Result[1]), @aSize) = ERROR_SUCCESS then
        Result := string(Result)
      else
        Result := AFontName;
    end;
  finally
    RegCloseKey(AKey);
  end
  else
    Result := AFontName;
end;
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
var
  WResult, Family : Widestring;
begin
  Result := AFontName;
  if AFontName = '' then Exit;
  Family := AFontName;
  QFont_substitute(@WResult, @Family);
  if WResult <> '' then
    Result := WResult;
end;
{$ENDIF LINUX}

procedure TJvFontComboBox.SetShowMRU(const Value: Boolean);
begin
  if FShowMRU <> Value then
  begin
    if FShowMRU then
      ClearMRU;
    FShowMRU := Value;
    if FShowMRU and Sorted then
      Sorted := False;
  end;
end;

function TJvFontComboBox.AddToMRU: Integer;
var
  I: Integer;
begin
  Result := ItemIndex;
  if (csDesigning in ComponentState) then Exit;
  if (MaxMRUCount = 0) or (MaxMRUCount > MRUCount) then
  begin
    I := Items.IndexOf(Text);
    if (I > MRUCount - 1) and (I >= 0) then
    begin
      Items.InsertObject(0, Items[I], Items.Objects[I]);
      Inc(FMRUCount);
    end
    else
    if I < 0 then
    begin
      Items.InsertObject(0, Text, TObject(TRUETYPE_FONTTYPE));
      Inc(FMRUCount);
    end;
    Result := 0;
  end
  else
  if (MRUCount > 0) and (ItemIndex > 0) then
  begin
    Items[0] := Items[ItemIndex];
    Items.Objects[0] := Items.Objects[ItemIndex];
    Result := 0;
  end;
end;

procedure TJvFontComboBox.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FWasMouse := False;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TJvFontComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FWasMouse := True;
  inherited  MouseUp(Button, Shift, X, Y);;
end;

procedure TJvFontComboBox.CloseUp;
begin
  inherited CloseUp;
  if FShowMRU then
  begin
    AddToMRU;
    ItemIndex := Items.IndexOf(Text);
    FWasMouse := False;
  end;
end;

procedure TJvFontComboBox.ClearMRU;
begin
  while FMRUCount > 0 do
  begin
    Items.Delete(0);
    Dec(FMRUCount);
  end;
end;

procedure TJvFontComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  // (rom) only accept without Shift, Alt or Ctrl down
  if (Shift * KeyboardShiftStates = []) and
    (Key = VK_RETURN) and FShowMRU then
    ItemIndex := AddToMRU;
  inherited KeyDown(Key, Shift);
end;

procedure TJvFontComboBox.SetMaxMRUCount(const Value: Integer);
var
  S: string;
begin
  if FMaxMRUCount <> Value then
  begin
    FMaxMRUCount := Value;
    if (FMaxMRUCount > 0) and (FMRUCount > 0) then
    begin
      S := Text;
      while FMRUCount > FMaxMRUCount do
      begin
        Items.Delete(0);
        Dec(FMRUCount);
      end;
      ItemIndex := Items.IndexOf(S);
      if ItemIndex < 0 then
        ItemIndex := 0;
    end;
  end;
end;

procedure TJvFontComboBox.SetParent(const AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if Parent <> nil then
  begin
    Reset;
    FontName := Font.Name;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQColorCombo.pas,v $';
    Revision: '$Revision: 1.10 $';
    Date: '$Date: 2005/02/06 14:06:02 $';
    LogPath: 'JVCL\qrun'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.