jvcharmap.pas

East make Tray Icon in delphi

      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;

{$IFNDEF COMPILER6_UP}
procedure TJvCustomCharMap.MouseToCell(X, Y: Integer;
  var ACol, ARow: Integer);
var
  Coord: TGridCoord;
begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
end;
{$ENDIF !COMPILER6_UP}

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;

{$IFDEF VCL}
procedure TJvCustomCharMap.SetLocale(const Value: LCID);
begin
  if (FLocale <> Value) and IsValidLocale(Value, LCID_SUPPORTED) then
  begin
    FLocale := Value;
    Invalidate;
  end;
end;
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure TJvCustomCharMap.SetAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then
  begin
    FAutoSize := Value;
    if FAutoSize then
      AdjustSize;
  end;
end;
{$ENDIF VisualCLX}

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;
    if not FShowZoomPanel then
      PanelVisible := False;
  end;
end;

procedure TJvCustomCharMap.ShowCharPanel(ACol, ARow: Integer);
var
  R: TRect;
  P: TPoint;
begin
  if not ShowZoomPanel or not SelectCell(ACol, ARow) then
  begin
    PanelVisible := False;
    Exit;
  end;
  R := CellRect(ACol, ARow);
  Selection := TGridRect(Rect(ACol, ARow, ACol, ARow));
  {$IFDEF VCL}
  {$IFDEF COMPILER6_UP}
  FocusCell(ACol, ARow, False);
  {$ELSE}
  Col := ACol;
  Row := ARow;
  {$ENDIF COMPILER6_UP}
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Col := ACol;
  Row := ARow;
  {$ENDIF VisualCLX}
  TCharZoomPanel(FCharPanel).Character := GetChar(ACol, ARow);
  P.X := R.Left - (FCharPanel.Width - DefaultColWidth) div 2;
  P.Y := R.Top - (FCharPanel.Height - DefaultRowHeight) div 2;
  P := ClientToScreen(P);

  FCharPanel.Left := P.X;
  FCharPanel.Top := P.Y;
  if not PanelVisible then
    PanelVisible := True;
end;

function TJvCustomCharMap.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  Result := True;
end;

{$IFDEF VCL}
procedure TJvCustomCharMap.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  if PanelVisible then
  begin
    if Col < LeftCol then
      ShowCharPanel(LeftCol, Row)
    else
    if Col >= LeftCol + VisibleColCount then
      ShowCharPanel(LeftCol + VisibleColCount - 1, Row)
    else
      ShowCharPanel(Col, Row);
  end;
end;

procedure TJvCustomCharMap.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  if PanelVisible then
  begin
    if Row < TopRow then
      ShowCharPanel(Col, TopRow)
    else
    if Row >= TopRow + VisibleRowCount then
      ShowCharPanel(Col, TopRow + VisibleRowCount - 1)
    else
      ShowCharPanel(Col, Row);
  end;
end;
{$ENDIF VCL}

//=== { TCharZoomPanel } =====================================================

constructor TCharZoomPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csNoDesignVisible, csOpaque];
  SetBounds(0, 0, 52, 48);
  FShadow := TShadowWindow.Create(AOwner);
  ShowShadow := True;
  FShadowSize := 2;
end;

destructor TCharZoomPanel.Destroy;
begin
  {$IFDEF VCL}
  UnhookWndProc;
  {$ENDIF VCL}
  inherited Destroy;
end;

procedure TCharZoomPanel.FontChanged;
begin
  inherited FontChanged;
  // (p3) height should be quite larger than Font.Height and Width a little more than that
  Height := Abs(Font.Height) * 4;
  Width := MulDiv(Height, 110, 100);
end;

procedure TCharZoomPanel.VisibleChanged;
begin
  inherited VisibleChanged;
  if Visible and CanFocus then
    SetFocus;
  if ShowShadow then
    FShadow.Visible := Visible
  else
    FShadow.Visible := False;
end;

{$IFDEF VCL}

procedure TCharZoomPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_BORDER or WS_POPUP;
    ExStyle := WS_EX_TOOLWINDOW;
  end;
end;

procedure TCharZoomPanel.HookWndProc;
var
  F: TCustomForm;
begin
  if not (csDesigning in ComponentState) and not Assigned(FOldWndProc) then
  begin
    F := GetParentForm(Self);
    if F <> nil then
    begin
      FOldWndProc := F.WindowProc;
      F.WindowProc := FormWindowProc;
    end;
  end;
end;

{$ENDIF VCL}

procedure TCharZoomPanel.KeyDown(var Key: Word; Shift: TShiftState);
begin
  // (rom) only accept without Shift, Alt or Ctrl down
  if Shift * KeyboardShiftStates = [] then
    case Key of
      VK_ESCAPE:
        begin
          Visible := False;
          if Parent.CanFocus then
            Parent.SetFocus;
        end;
      VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
        TJvCustomCharMap(Parent).KeyDown(Key, Shift);
    else
      inherited KeyDown(Key, Shift);
    end
  else
    inherited KeyDown(Key, Shift);
end;

{$IFDEF VCL}
procedure TCharZoomPanel.FormWindowProc(var Msg: TMessage);
begin
  FOldWndProc(Msg);
  if not (csDestroying in ComponentState) then
  begin
    case Msg.Msg of
      WM_MOVE: