jvqcharmap.pas

East make Tray Icon in delphi

//=== { TJvCustomCharMap } ===================================================

constructor TJvCustomCharMap.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DoubleBuffered := True;
  //  DefaultDrawing := False;
  //  VirtualView := True;

  FCharRange := TJvCharMapRange.Create;
  //  FCharRange.Filter := ufUndefined;
  //  FCharRange.SetRange($21, $FF);
  FCharRange.OnChange := DoRangeChange;
  FCharPanel := TCharZoomPanel.Create(Self);
  FCharPanel.Visible := False;
  FCharPanel.Parent := Self;

  Options := [goVertLine, goHorzLine, {goDrawFocusSelected, } goThumbTracking];
  FShowZoomPanel := True;
  DefaultRowHeight := Abs(Font.Height) + 12;
  DefaultColWidth := DefaultRowHeight - 5; 
  FShowShadow := True;
  FShadowSize := 2;
  FHighlightInvalid := True;
  Columns := 20;
end;

destructor TJvCustomCharMap.Destroy;
begin
  FCharRange.Free;
  inherited Destroy;
end;

procedure TJvCustomCharMap.AdjustSize;
var
  AWidth, AHeight: Integer;
begin
  if HandleAllocated and (ColCount > 0) and (RowCount > 0) then
  begin
    AWidth := DefaultColWidth * (ColCount) + ColCount;
    AHeight := DefaultRowHeight * (RowCount) + RowCount;
    if AutoSizeWidth and (ClientWidth <> AWidth) and
       (Align in [alNone, alLeft, alRight]) then
      ClientWidth := AWidth;
    if AutoSizeHeight and (ClientHeight <> AHeight) and
       (Align in [alNone, alTop, alBottom]) then
      ClientHeight := AHeight;
  end;
end;

function TJvCustomCharMap.CellSize: TSize;
begin
  Result.cx := DefaultColWidth;
  Result.cy := DefaultRowHeight;
end;

procedure TJvCustomCharMap.FontChanged;
begin
  inherited FontChanged;
  if AutoSize then
    AdjustSize;
  RecalcCells;
end;




procedure TJvCustomCharMap.CreateWidget;
begin
  inherited CreateWidget;
  RecalcCells;
end;


function TJvCustomCharMap.DoMouseWheelDown(Shift: TShiftState;  const  MousePos: TPoint): Boolean;
begin
  // ignore the return value, because inherited always returns True
  inherited DoMouseWheelDown(Shift, MousePos);
  Result := PanelVisible and SelectCell(Col, Row);
  if Result then
    ShowCharPanel(Col, Row);
  Result := True;
end;

function TJvCustomCharMap.DoMouseWheelUp(Shift: TShiftState;  const  MousePos: TPoint): Boolean;
begin
  // ignore the return value, because inherited always returns True
  inherited DoMouseWheelUp(Shift, MousePos);
  Result := PanelVisible and SelectCell(Col, Row);
  if Result then
    ShowCharPanel(Col, Row);
  Result := True;
end;

procedure TJvCustomCharMap.DoRangeChange(Sender: TObject);
begin
  TCharZoomPanel(FCharPanel).FEndChar := CharRange.EndChar;
  RecalcCells;
end;

procedure TJvCustomCharMap.DoSelectChar(AChar: WideChar);
begin
  if Assigned(FOnSelectChar) then
    FOnSelectChar(Self, AChar);
end;

procedure TJvCustomCharMap.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  AChar: WideChar;
  LineColor: TColor;
begin
  if FDrawing then
    Exit;
  FDrawing := True;
  try 
    inherited DrawCell(ACol, ARow, ARect, AState); 
    AChar := GetChar(ACol, ARow);
    Canvas.Brush.Color := Color;
    Canvas.Font := Font;
    Canvas.Pen.Color := Font.Color;
    if SelectCell(ACol, ARow) and IsValidChar(AChar) then
    begin
      if AState * [gdSelected, gdFocused] <> [] then
      begin
        Canvas.Pen.Color := Font.Color;
        if not ShowZoomPanel then
        begin
          Canvas.Brush.Color := clHighlight;
          Canvas.FillRect(ARect);
        end;
        InflateRect(ARect, -1, -1);
        Canvas.Rectangle(ARect);
        InflateRect(ARect, 1, 1);
      end
      else
        Canvas.FillRect(ARect);
      if not ShowZoomPanel and (AState * [gdSelected, gdFocused] <> []) then
        Canvas.Font.Color := clHighlightText;
      SetBkMode(Canvas.Handle, QWindows.TRANSPARENT);
      WideDrawText(Canvas, AChar, ARect,
        DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_NOPREFIX);
    end
    else
    if HighlightInvalid then
    begin
      LineColor := clSilver;
      if ColorToRGB(Color) = clSilver then
        LineColor := clGray;
      Canvas.Pen.Color := Color;
      Canvas.Brush.Color := LineColor;
      Canvas.Brush.Style := bsBDiagonal;
      // InflateRect(ARect,1,1);
      Canvas.Rectangle(ARect);
      Canvas.Brush.Style := bsSolid;
    end;
    finally
      FDrawing := False;
    end;
end;

function TJvCustomCharMap.GetChar(ACol, ARow: Integer): WideChar;
begin
  if (ARow < 0) or (ACol < 0) then
    Result := WideChar(0)
  else
    Result := WideChar(CharRange.StartChar +
      Cardinal(ARow) * Cardinal(ColCount) + Cardinal(ACol));
end;

function TJvCustomCharMap.GetCharacter: WideChar;
begin
  Result := GetChar(Col, Row);
end;

function TJvCustomCharMap.GetCharInfo(ACol, ARow: Integer;
  InfoType: Cardinal): Cardinal;
begin
  Result := GetCharInfo(GetChar(ACol, ARow), InfoType);
end;

function TJvCustomCharMap.GetCharInfo(AChar: WideChar;
  InfoType: Cardinal): Cardinal;
var
  LCharInfo: Cardinal;
begin
  LCharInfo := 0;  
  {TODO : implement this if possible}
  Result := LCharInfo; 
end;

function TJvCustomCharMap.GetColumns: Integer;
begin
  Result := ColCount;
end;

function TJvCustomCharMap.GetPanelVisible: Boolean;
begin
  if (FCharPanel <> nil) and (Parent <> nil) and
     not (csDesigning in ComponentState) then
    Result := FCharPanel.Visible
  else
    Result := False;
end;

function TJvCustomCharMap.IsValidChar(AChar: WideChar): Boolean;
var
  LCharInfo: Cardinal;
begin
  Result := False;
  if (AChar >= WideChar(CharRange.StartChar)) and
    (AChar <= WideChar(CharRange.EndChar)) then
  begin
    LCharInfo := GetCharInfo(AChar, CT_CTYPE1);
    Result := (LCharInfo <> 0); //  and (LCharInfo and C1_CNTRL <> C1_CNTRL);
  end;

  if Assigned(FOnValidateChar) then
    FOnValidateChar(Self, AChar, Result);
end;

procedure TJvCustomCharMap.KeyDown(var Key: Word; Shift: TShiftState);
var
  ACol, ARow: Integer;
begin
  // store previous location
  ACol := Col;
  ARow := Row;
  // update new location
  inherited KeyDown(Key, Shift);
  // (rom) only accept without Shift, Alt or Ctrl down
  if Shift * KeyboardShiftStates = [] then
    case Key of
      VK_RETURN:
        ShowCharPanel(Col, Row);
      VK_SPACE:
        PanelVisible := not PanelVisible;
      VK_ESCAPE:
        PanelVisible := False;
      VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_HOME, VK_END:
        if PanelVisible then
          ShowCharPanel(Col, Row);
      VK_LEFT:
        begin
          if (ACol = 0) and (ARow > 0) then
          begin
            ACol := ColCount - 1;
            Dec(ARow);
          end
          else
          begin
            ACol := Col;
            ARow := Row;
          end;
          Col := ACol;
          Row := ARow;
          if PanelVisible then
            ShowCharPanel(ACol, ARow);
        end;
      VK_RIGHT:
        begin
          if (ACol = ColCount - 1) and (ARow < RowCount - 1) then
          begin
            ACol := 0;
            Inc(ARow);
          end
          else
          begin
            ACol := Col;
            ARow := Row;
          end;
          Col := ACol;
          Row := ARow;
          if PanelVisible then
            ShowCharPanel(ACol, ARow);
        end;
    end;
end;

procedure TJvCustomCharMap.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  GC: TGridCoord;
  ACol, ARow: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  //  MouseCapture := True;
  if Button = mbLeft then
  begin
    FMouseIsDown := True;
    GC := MouseCoord(X, Y);
    MouseToCell(X, Y, ACol, ARow);
    if SelectCell(ACol, ARow) then
      ShowCharPanel(ACol, ARow)
    else
    if SelectCell(Col, Row) then
      ShowCharPanel(Col, Row);
  end;
end;

procedure TJvCustomCharMap.MouseMove(Shift: TShiftState; X, Y: Integer);
//var
//  ACol, ARow: Integer;
begin
  inherited MouseMove(Shift, X, Y);
  {  if csLButtonDown in ControlState then
    begin
      MouseToCell(X, Y, ACol, ARow);
      if SelectCell(ACol, ARow) then
        ShowCharPanel(ACol, ARow);
    end;}
end;



procedure TJvCustomCharMap.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  ACol, ARow: Integer;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and FMouseIsDown then
  begin
    FMouseIsDown := False;
    MouseToCell(X, Y, ACol, ARow);
    if SelectCell(ACol, ARow) then
      ShowCharPanel(ACol, ARow)
    else
    if SelectCell(Col, Row) then
      ShowCharPanel(Col, Row);
  end;
end;

function TJvCustomCharMap.InCharRange(AChar: WideChar): Boolean;
begin
  Result := (AChar >= WideChar(CharRange.StartChar)) and (AChar <= WideChar(CharRange.EndChar));
end;

function TJvCustomCharMap.InGridRange(ACol, ARow: Integer): Boolean;
begin
  Result := (ACol >= 0) and (ARow >= 0) and (ACol < ColCount) and (ARow < RowCount);
end;

procedure TJvCustomCharMap.RecalcCells;
var
  ACells, ARows: Integer;
begin
  if not HandleAllocated then
    Exit;
  FixedCols := 0;
  FixedRows := 0;
  ACells := Ord(CharRange.EndChar) - Ord(CharRange.StartChar);
  //  ColCount := 20;
  ARows := ACells div ColCount + 1;
  RowCount := ARows;
  DefaultRowHeight := Abs(Font.Height) + 12;
  DefaultColWidth := DefaultRowHeight - 5;
  if AutoSizeWidth or AutoSizeHeight then
    AdjustSize;
  if PanelVisible then
    ShowCharPanel(Col, Row);
end;

function TJvCustomCharMap.SelectCell(ACol, ARow: Integer): Boolean;
var
  AChar, ANewChar: WideChar;
begin
  // get currently selected character
  AChar := GetChar(Col, Row);
  // can't use IsValidChar here since we need to be able to select invalid cells as well to be able to scroll
  ANewChar := WideChar(CharRange.StartChar + Cardinal(ARow) * Cardinal(ColCount) + Cardinal(ACol));
  Result := InGridRange(ACol,ARow) and InCharRange(ANewChar);

  if Result and not FDrawing then
  begin
    ANewChar := GetChar(ACol, ARow);
    if AChar <> ANewChar then
      DoSelectChar(ANewChar);
  end;
end;

procedure TJvCustomCharMap.SetAutoSizeHeight(Value: Boolean);
begin
  if FAutoSizeHeight <> Value then
  begin
    FAutoSizeHeight := Value;
    if FAutoSizeHeight then
      AdjustSize;
  end;
end;

procedure TJvCustomCharMap.SetAutoSizeWidth(Value: Boolean);
begin
  if FAutoSizeWidth <> Value then
  begin
    FAutoSizeWidth := Value;
    if FAutoSizeWidth then
      AdjustSize;
  end;
end;

procedure TJvCustomCharMap.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  RecalcCells;
  if HandleAllocated and PanelVisible and ((ClientHeight < DefaultRowHeight) or
    (ClientWidth < DefaultColWidth)) then
    PanelVisible := False;
end;

procedure TJvCustomCharMap.SetCharRange(const Value: TJvCharMapRange);
begin
  //  FCharRange := Value;
end;

procedure TJvCustomCharMap.SetColumns(Value: Integer);
var
  CurCell: Integer;
begin
  if Value > 0 then
  begin
    // make sure the previous select character is also the new selected
    CurCell := Row * ColCount + Col;
    ColCount := Value;
    // Assert(ColCount >  0);
    Col := CurCell mod ColCount;
    Row := CurCell div ColCount;
    RecalcCells;
  end;
end;

procedure TJvCustomCharMap.SetHighlightInvalid(Value: Boolean);
begin
  if FHighlightInvalid <> Value then
  begin
    FHighlightInvalid := Value;
    Invalidate;
  end;
end;



procedure TJvCustomCharMap.SetAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then
  begin
    FAutoSize := Value;
    if FAutoSize then
      AdjustSize;
  end;
end;


procedure TJvCustomCharMap.SetPanelVisible(Value: Boolean);
begin
  if (PanelVisible <> Value) and not (csDesigning in ComponentState) then
    FCharPanel.Visible := Value;
end;

procedure TJvCustomCharMap.SetShadowSize(Value: Integer);
begin
  if FShadowSize <> Value then
  begin
    FShadowSize := Value;
    if FCharPanel <> nil then
      TCharZoomPanel(FCharPanel).ShadowSize := Value;
  end;
end;

procedure TJvCustomCharMap.SetShowShadow(Value: Boolean);
begin
  if FShowShadow <> Value then
  begin
    FShowShadow := Value;
    if FCharPanel <> nil then
      TCharZoomPanel(FCharPanel).ShowShadow := Value;
  end;
end;

procedure TJvCustomCharMap.SetShowZoomPanel(Value: Boolean);
begin
  if FShowZoomPanel <> Value then
  begin
    FShowZoomPanel := Value;