inssymbolrvfrm.pas

richviewaction 1.58 需要richview 1.9.46

  ACharset: TFontCharset); 
var idx: Integer; 
begin 
  cmbFont.ItemIndex := cmbFont.Items.IndexOf(AFontName); 
  if cmbFont.ItemIndex<0 then 
    cmbFont.ItemIndex := 0; 
  cmbFontClick(nil);
  idx := cmbCharset.IndexOfCharset(ACharset); 
  if idx>=0 then 
    cmbCharset.ItemIndex := idx; 
  cmbCharsetClick(nil); 
  if Char=0 then
    Char := offset;
  dec(Char, offset); 
  dg.SelectCell(Char mod 28, Char div 28);
end;

procedure TfrmRVInsertSymbol.SetOptions(AllowUnicode, AllowANSI,
  UseBlocks: Boolean); 
var idx: Integer; 
begin
  FUseBlocks := UseBlocks;
  if not AllowANSI then begin 
    idx := cmbCharset.IndexOfCharset(DEFAULT_CHARSET); 
    if idx>=0 then 
      cmbCharset.ItemIndex := idx; 
    cmbCharset.Visible := False; 
    _lblCharset.Visible := False;
    _lblBlock.Visible := UseBlocks;
    cmbBlock.Visible := UseBlocks;
  end;
  if not AllowUnicode then begin
    cmbCharset.AddDefaultCharset := False;
    _lblBlock.Visible := False;
    cmbBlock.Visible := False;
  end;
  cmbCharsetClick(nil);
end;

procedure TfrmRVInsertSymbol.GetInfo(var Char: Word;
  var AFontName: String; var ACharset: TFontCharset);
begin
  Char := offset+{32+}dg.Row*dg.ColCount+dg.Col;
  AFontName := FontName;
  ACharset  := FontCharset;
end;

procedure TfrmRVInsertSymbol.dgDrawCell(Sender: TObject; ACol,
  ARow: Integer; ARect: TRect; Selected: Boolean);
var sz: TSize;
    s: String;
    ws: WideString; 
begin 
  dg.Canvas.FillRect(ARect); 
  dg.Canvas.Font.Name := FontName; 
  dg.Canvas.Font.Charset := FontCharset; 
  dg.Canvas.Font.Style := []; 
  dg.Canvas.Font.Size := MulDiv(Min(dg.Width, dg.Height * 2), 10, 320); 
  offset:=$0020; 
  endpos:=$FFFF; 
  if FontCharset<>DEFAULT_CHARSET then begin 
    s := Char(offset+ARow*dg.ColCount+ACol); 
    sz := dg.Canvas.TextExtent(s); 
    sz.cx := (ARect.Right-ARect.Left-sz.cx) div 2 + ARect.Left; 
    sz.cy := (ARect.Bottom-ARect.Top-sz.cy) div 2 + ARect.Top; 
    dg.Canvas.TextOut(sz.cx, sz.cy, s);
    end
  else begin
    //unicode blocks
    Offset:=uniBlocks[cmbBlock.ItemIndex].s;
    EndPos:=uniBlocks[cmbBlock.ItemIndex].e;
    if offset+{32+}ARow*dg.ColCount+ACol>endpos then
      exit;
    ws := WideChar(offset+{32+}ARow*dg.ColCount+ACol);
    GetTextExtentPoint32W(dg.Canvas.Handle, PWideChar(ws), 1, sz);
    sz.cx := (ARect.Right-ARect.Left-sz.cx) div 2 + ARect.Left;
    sz.cy := (ARect.Bottom-ARect.Top-sz.cy) div 2 + ARect.Top;
    TextOutW(dg.Canvas.Handle, sz.cx, sz.cy, PWideChar(ws), 1);
  end;
end;

procedure TfrmRVInsertSymbol.cmbFontClick(Sender: TObject);
begin
  if cmbFont.ItemIndex<0 then
    exit;
  dg.repaint;
  FontName := cmbFont.Items[cmbFont.ItemIndex];
  if Panel<>nil then begin
    Panel.FontName := FontName;
    Panel.Refresh;
  end;
  cmbCharset.FontName := FontName;
end;

procedure TfrmRVInsertSymbol.cmbCharsetClick(Sender: TObject);
var rowcount: Integer;
begin
  FontCharset := cmbCharset.Charsets[cmbCharset.ItemIndex];
  if Panel<>nil then
    Panel.FontCharset := FontCharset;
  if FontCharset=DEFAULT_CHARSET then
    begin
      Offset:=uniBlocks[cmbBlock.ItemIndex].s;
      EndPos:=uniBlocks[cmbBlock.ItemIndex].e;
      rowcount := (EndPos-Offset+1) div dg.ColCount;
      if (EndPos-Offset+1) mod dg.ColCount>0 then
        inc(rowcount);
      dg.RowCount := rowcount;
    end
  else
    dg.RowCount := 8;
  cmbBlock.Visible:=(FontCharset=DEFAULT_CHARSET) and FUseBlocks;
  _lblBlock.Visible:=(FontCharset=DEFAULT_CHARSET) and FUseBlocks;
  dgSelectCell(dg);
end; 

procedure TfrmRVInsertSymbol.dgSelectCell(Sender: TObject); 
var 
  ARow, ACol: Integer; 
  ARect: TRect; 
begin 
  _btnOk.Enabled := True;
  ARow := Max(dg.Row, 0); 
  ACol := Max(dg.Col, 0); 
  if FontCharset<>DEFAULT_CHARSET then 
    Label1.Caption := Format(RVA_GetS(rvam_is_CharCode), [offset+{32+}ARow*dg.ColCount+ACol]) 
  else if offset+{32+}ARow*dg.ColCount+ACol>endpos then begin 
    Label1.Caption := RVA_GetS(rvam_is_NoChar); 
    _btnOk.Enabled := False; 
    end 
  else 
    Label1.Caption := Format(RVA_GetS(rvam_is_UCharCode), [{32+}Offset+ARow*dg.ColCount+ACol]); 
  if Panel=nil then 
    exit; 
  if FontCharset<>DEFAULT_CHARSET then 
    Panel.Text := Chr(offset+{32+}ARow*dg.ColCount+ACol) 
  else begin 
    if {32+}Offset+ARow*dg.ColCount+ACol>endpos then 
      Panel.TextW := '' 
    else 
      Panel.TextW := WideChar({32+}Offset+ARow*dg.ColCount+ACol);
  end; 
  // The code below replaces the huge .SetBounds that was here before
  ARect := dg.GetCellRect(ACol, ARow);
  InflateRect(ARect, 10, 10); 
  OffsetRect(ARect, dg.Left, dg.Top);
  Panel.DefWidth := ARect.Right - ARect.Left;
  with ARect do Panel.SetBounds(Left, Top, Right - Left, Bottom - Top);
  // --- 
  Panel.Refresh; 
end;

{ TZoomPanel } 

procedure TZoomPanel.CMDenySubclassing(var Msg: TMessage); 
begin 
  Msg.Result := 1; 
end; 

procedure TZoomPanel.Paint; 
var r: TRect; 
    sz: TSize; 
    w: Integer; 
begin 
  Canvas.Brush.Color := clHighlight; 
  r := ClientRect; 
  Canvas.FillRect(r); 
  Canvas.Font.Height := Height-10; 
  Canvas.Font.Name := FontName; 
  Canvas.Font.Charset := FontCharset; 
  Canvas.Font.Color := clHighlightText; 
  Canvas.Pen.Color := clActiveBorder; 
  Canvas.Rectangle(0,0,r.Right,r.Bottom); 
  Canvas.Brush.Style := bsClear; 
  if FontCharset<>DEFAULT_CHARSET then begin
    sz := Canvas.TextExtent(Text); 
    w := sz.cx;
    sz.cx := (ClientWidth-sz.cx) div 2; 
    sz.cy := (ClientHeight-sz.cy) div 2; 
    Canvas.TextOut(sz.cx, sz.cy, Text);
    end
  else begin
    GetTextExtentPoint32W(Canvas.Handle, PWideChar(TextW), Length(TextW), sz);
    w := sz.cx;
    sz.cx := (ClientWidth-sz.cx) div 2;
    sz.cy := (ClientHeight-sz.cy) div 2;
    TextOutW(Canvas.Handle, sz.cx, sz.cy, PWideChar(TextW), Length(TextW));
  end;
  if w > DefWidth then 
    Width := w; 
{  else 
    Width := DefWidth;} 
end; 

procedure TZoomPanel.WMNCHitTest(var Message: TWMNCHitTest); 
begin 
  Message.Result := HTTRANSPARENT; 
end; 

procedure TfrmRVInsertSymbol.Localize; 
begin 
  inherited; 
  Caption := {$IFDEF USERVTNT}_GetWideString{$ENDIF}(RVA_GetS(rvam_is_Title)); 
  btnOk.Caption := RVA_GetS(rvam_btn_Insert); 
  btnCancel.Caption := RVA_GetS(rvam_btn_Cancel); 
  lblFont.Caption := RVA_GetS(rvam_is_Font); 
  lblCharset.Caption := RVA_GetS(rvam_is_Charset);
  lblBlock.Caption := RVA_GetS(rvam_is_Block);
  cmbCharset.DefaultCharsetCaption := RVA_GetS(rvam_is_Unicode); 
end;

procedure TfrmRVInsertSymbol.dgTopLeftChanged(Sender: TObject);
begin 
  dgSelectCell(dg); // actually, onSelectCell is called twice... 
                    // see DoTopLeftChanged first two "if"s
                    // but it doesn't matter IMHO 
end; 

procedure TfrmRVInsertSymbol.FormResize(Sender: TObject); 
begin 
  dgSelectCell(dg); // to adjust Zoompanel position 
end; 

procedure TfrmRVInsertSymbol.dgEnter(Sender: TObject); 
begin 
  Panel.Visible := True; // also to adjust Zoompanel position 
end; 

{$IFDEF RVASKINNED}
procedure TfrmRVInsertSymbol.OnCreateThemedControl(OldControl,
  NewControl: TControl);
begin
  if OldControl = _btnOk then
    _btnOk := NewControl
  else if OldControl = _lblCharset then
    _lblCharset := NewControl
  else if OldControl = _lblBlock then
    _lblBlock := NewControl;
end;

function TfrmRVInsertSymbol.IsThemeAllowedFor(Component: TComponent): Boolean;
begin
  if (Component=Label1) or (Component=cmbBlock) then
    Result := False
  else
    Result := inherited IsThemeAllowedFor(Component);
end;
{$ENDIF}

procedure TfrmRVInsertSymbol.cmbBlockClick(Sender: TObject);
begin
  //unicode blocks
  if FontCharset=DEFAULT_CHARSET then begin
    dg.SelectCell(0, 0);
    cmbCharsetClick(nil);
  end;
end;

end.