rm_editorcellprop.pas

这是一个功能强大

    FDisplayFormat.FormatdelimiterChar := edtFormatSpl.Text[1]
  else
    FDisplayFormat.FormatdelimiterChar := ',';
  if edtForamtStr.Enabled then
    FDisplayFormatStr := edtForamtStr.Text;

  for i := FCellRange.Top to FCellRange.Bottom do
  begin
    j := FCellRange.Left;
    while j <= FCellRange.Right do
    begin
      liCell := TRMGridEx(ParentGrid).Cells[j, i];
      if liCell.StartRow = i then
      begin
        _SetOneCell;
      end;
      j := liCell.EndCol + 1;
    end;
  end;
end;

procedure TRMCellPropForm.FormShow(Sender: TObject);
var
  liDC: HDC;
begin
  liDC := GetDC(0);
  try
    EnumFontFamilies(RMDesigner.Report.ReportPrinter.DC, nil, @EnumFontsProc, Longint(lstFontName));
  finally
    ReleaseDC(0, liDC);
  end;

  Localize;
  FCellRange := TRect(TRMGridEx(ParentGrid).Selection);
  GetFirstCellProp;
end;

procedure TRMCellPropForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  PageCtlCellProp.ActivePage := TabSheetCellType;
  FTrueTypeBMP := RMCreateBitmap('RM_TRUETYPE_FNT');
  FDeviceBMP := RMCreateBitmap('RM_DEVICE_FNT');

  for i := 0 to Integer(High(TPenStyle)) - 2 do
  begin
    EDLeftStyle.Items.Add('');
  end;

  FCmbFrameWidth := TComboBox.Create(Self);
  with FCmbFrameWidth do
  begin
    Parent := TabSheet1;
    DropDownCount := 14;
    SetBounds(200, 68, 119, 21);
    Items.Add('0.1');
    Items.Add('0.5');
    Items.Add('1');
    Items.Add('1.5');
    for i := 2 to 9 do
      Items.Add(IntToStr(i));
  end;

  FBtnFrameColor := TRMColorPickerButton.Create(Self);
  with FBtnFrameColor do
  begin
    Parent := TabSheet1;
    Flat := False;
    SetBounds(200, 92, 119, 21);
//    Caption := RMLoadStr(rmRes + 523);
    ColorType := rmptLine;
//    OnColorChange := OnColorChangeEvent;
  end;

  FBusy := False;
end;

procedure TRMCellPropForm.FormDestroy(Sender: TObject);
begin
  FTrueTypeBmp.Free;
  FDeviceBmp.Free;
end;

procedure TRMCellPropForm.lstFontNameClick(Sender: TObject);
begin
  PanelFontPreview1.Font.Name := lstFontName.Items[lstFontName.ItemIndex];
  PanelFontPreview1.Caption := PanelFontPreview1.Font.Name;
  if RMIsChineseGB then
  begin
    if ByteType(PanelFontPreview1.Font.Name, 1) = mbSingleByte then
      PanelFontPreview1.Font.Charset := ANSI_CHARSET
    else
      PanelFontPreview1.Font.Charset := GB2312_CHARSET;
  end;
end;

procedure TRMCellPropForm.lstFontStyleClick(Sender: TObject);
begin
  case lstFontStyle.ItemIndex of
    0: PanelFontPreview1.Font.Style := [];
    1: PanelFontPreview1.Font.Style := [fsItalic];
    2: PanelFontPreview1.Font.Style := [fsBold];
    3: PanelFontPreview1.Font.Style := [fsBold, fsItalic];
  end;
end;

procedure TRMCellPropForm.lstFontSizeClick(Sender: TObject);
begin
  EditFontSize.Text := lstFontSize.Items[lstFontSize.ItemIndex];
  PanelFontPreview1.Font.Size := RMGetFontSize1(lstFontSize.ItemIndex, lstFontSize.Items[lstFontSize.ItemIndex]);
end;

procedure TRMCellPropForm.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
  TEdit((Sender as TUpDown).Associate).Enabled := True;
end;

procedure TRMCellPropForm.BtnSetFontColorClick(Sender: TObject);
begin
  if ColorDialogCellProp.Execute then
  begin
    PanelFontPreview1.Font.Color := ColorDialogCellProp.Color;
    PanelFontColor.Color := ColorDialogCellProp.Color;
    PanelFontColor.Visible := True;
  end;
end;

procedure TRMCellPropForm.cmbHAlignClick(Sender: TObject);
begin
  if cmbVAlign.ItemIndex < 0 then
    cmbVAlign.ItemIndex := 0;
end;

procedure TRMCellPropForm.cmbVAlignClick(Sender: TObject);
begin
  if cmbHAlign.ItemIndex < 0 then
    cmbHAlign.ItemIndex := 0;
end;

procedure TRMCellPropForm.SetFrameMsg(aMsgs: array of Integer);
var
  i: Integer;
begin
  for i := Low(aMsgs) to High(aMsgs) do
  begin
    FFrameMsgs[aMsgs[i]].FrameStyle := TPenStyle(EDLeftStyle.ItemIndex);
    FFrameMsgs[aMsgs[i]].FrameWidth := StrToFloat(FCmbFrameWidth.Text);
    FFrameMsgs[aMsgs[i]].FrameColor := FBtnFrameColor.CurrentColor;
    FFrameMsgs[aMsgs[i]].FrameDouble := chkDoubleLeft.Checked;
    FFrameMsgs[aMsgs[i]].FrameVisible := FFrameButtons[aMsgs[i]].Down;
  end;
end;

procedure TRMCellPropForm.ShowBorderSample;
begin
  BordersBox.Invalidate;
end;

{$WARNINGS OFF}

procedure TRMCellPropForm.ShowFormatPanels;
begin
  RMEnableControls([Label1, Label2, edtFormatDec, edtFormatSpl], (lstFormatFolder.ItemIndex = 1) and (lstFormatType.ItemIndex <> lstFormatType.Items.Count - 1));
  if edtFormatDec.Enabled then
  begin
    edtFormatDec.Text := IntToStr(FDisplayFormat.FormatPercent);
    edtFormatSpl.Text := FDisplayFormat.FormatdelimiterChar;
  end
  else
  begin
    edtFormatDec.Text := '';
    edtFormatSpl.Text := '';
  end;

  RMEnableControls([Label3, edtForamtStr], lstFormatType.ItemIndex = lstFormatType.Items.Count - 1);
  if edtForamtStr.Enabled then
    edtForamtStr.Text := FDisplayFormatStr
  else
    edtForamtStr.Text := '';
end;

{$WARNINGS ON}

procedure TRMCellPropForm.lstFormatFolderClick(Sender: TObject);
var
  i: Integer;
begin
  lstFormatType.Items.Clear;
  case lstFormatFolder.ItemIndex of
    0: // 字符型
      begin
        lstFormatType.Items.Add(RMLoadStr(SFormat11));
      end;
    1: // 数字型
      begin
        for i := 0 to RMFormatNumCount do
          lstFormatType.Items.Add(RMLoadStr(SFormat21 + i));
      end;
    2: // 日期型
      begin
        for i := 0 to RMFormatDateCount do
          lstFormatType.Items.Add(RMLoadStr(SFormat31 + i));
      end;
    3: // 时间型
      begin
        for i := 0 to RMFormatTimeCount do
          lstFormatType.Items.Add(RMLoadStr(SFormat41 + i));
      end;
    4: // 逻辑型
      begin
        for i := 0 to RMFormatBooleanCount do
          lstFormatType.Items.Add(RMLoadStr(SFormat51 + i));
      end;
  end;

  lstFormatType.ItemIndex := 0;
  lstFormatTypeClick(nil);
end;

procedure TRMCellPropForm.lstFormatTypeClick(Sender: TObject);
begin
  ShowFormatPanels;
end;

procedure TRMCellPropForm.edtFormatSplEnter(Sender: TObject);
begin
  edtFormatSpl.SelectAll;
end;

procedure TRMCellPropForm.EditFontSizeKeyPress(Sender: TObject;
  var Key: Char);
begin
  if not (integer(Key) in [$30..$39, VK_BACK, VK_INSERT, VK_END, VK_HOME]) then
    Key := #0;
end;

procedure TRMCellPropForm.lstFontNameDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  BmpWidth: Integer;
  s: string;
  h: Integer;
begin
  lstFontName.Canvas.FillRect(Rect);
  BmpWidth := 15;
  if (Integer(lstFontName.Items.Objects[Index]) and TRUETYPE_FONTTYPE) <> 0 then
    Bitmap := FTrueTypeBMP
  else if (Integer(lstFontName.Items.Objects[Index]) and DEVICE_FONTTYPE) <> 0 then
    Bitmap := FDeviceBMP
  else
    Bitmap := nil;
  if Bitmap <> nil then
  begin
    BmpWidth := Bitmap.Width;
    lstFontName.Canvas.BrushCopy(Bounds(Rect.Left + 2, (Rect.Top + Rect.Bottom - Bitmap.Height)
      div 2, Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
      Bitmap.Height), Bitmap.TransparentColor);
  end;

  Rect.Left := Rect.Left + BmpWidth + 6;
  s := lstFontName.Items[index];
  h := lstFontName.Canvas.TextHeight(s);
  lstFontName.Canvas.TextOut(Rect.Left, Rect.Top + (Rect.Bottom - Rect.Top - h) div 2, s);
end;

procedure TRMCellPropForm.btnBorderFrameClick(Sender: TObject);
begin
  FFrameChanged := True;
  btnBorderTop.Down := True;
  btnBorderBottom.Down := True;
  btnBorderLeft.Down := True;
  btnBorderRight.Down := True;
  SetFrameMsg([1, 3, 4, 6]);
  ShowBorderSample;
end;

procedure TRMCellPropForm.btnBorderNoFrameClick(Sender: TObject);
begin
  FFrameChanged := True;
  btnBorderTop.Down := False;
  btnBorderBottom.Down := False;
  btnBorderVInternal.Down := False;
  btnBorderLeft.Down := False;
  btnBorderRight.Down := False;
  btnBorderHInternal.Down := False;
  SetFrameMsg([1, 2, 3, 4, 5, 6]);
  ShowBorderSample;
end;

procedure TRMCellPropForm.EDLeftStyleDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  LineWidth = 4;
var
  i: integer;
begin
  with TComboBox(Control).Canvas do
  begin
    Pen.Color := clBlack;
    Pen.Style := TPenStyle(index);
    Brush.Color := clWhite;
    FillRect(Rect);

    i := Rect.Top + (Rect.Bottom - Rect.Top - LineWidth) div 2;
    for i := i to i + LineWidth - 1 do
    begin
      MoveTo(Rect.Left + 3, i);
      LineTo(Rect.Right - 3, i);
    end;
  end;
end;

procedure TRMCellPropForm.btnBorderInsideClick(Sender: TObject);
begin
  FFrameChanged := True;
  btnBorderHInternal.Down := True;
  btnBorderVInternal.Down := True;
  SetFrameMsg([2, 5]);
  ShowBorderSample;
end;

procedure TRMCellPropForm.btnBorderAllClick(Sender: TObject);
begin
  FFrameChanged := True;
  btnBorderTop.Down := True;
  btnBorderBottom.Down := True;
  btnBorderVInternal.Down := True;
  btnBorderLeft.Down := True;
  btnBorderRight.Down := True;
  btnBorderHInternal.Down := True;
  SetFrameMsg([1, 2, 3, 4, 5, 6]);
  ShowBorderSample;
end;

procedure TRMCellPropForm.btnBorderTopClick(Sender: TObject);
begin
  FFrameChanged := True;
  SetFrameMsg([TSpeedButton(Sender).Tag]);
  ShowBorderSample;
end;

const
  con_margin = 5;

const
  PenStyles: array[psSolid..psInsideFrame] of DWORD =
  (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL, PS_INSIDEFRAME);

procedure TRMCellPropForm.BordersBoxPaint(Sender: TObject);
var
  i: Integer;
  tb: {$IFDEF COMPILER4_UP}tagLOGBRUSH{$ELSE}TLogBrush{$ENDIF};
  NewH, OldH: HGDIOBJ;

  procedure _SetPS(aColor: TColor; aStyle: TPenStyle; aWidth: integer);
  begin
    tb.lbStyle := BS_SOLID;
    tb.lbColor := aColor;
    NewH := ExtCreatePen(PS_GEOMETRIC + PS_ENDCAP_SQUARE + PenStyles[aStyle], aWidth, tb, 0, nil);
    OldH := SelectObject(BordersBox.Canvas.Handle, NewH);
  end;

begin
  if FBusy then Exit;

  FBusy := True;
  for i := 1 to 6 do
  begin
    if not FFrameMsgs[i].FrameVisible then Continue;

    _SetPS(FFrameMsgs[i].FrameColor, FFrameMsgs[i].FrameStyle, Round(FFrameMsgs[i].FrameWidth));
    case i of
      1:
        begin
          MoveToEx(BordersBox.Canvas.Handle, con_margin, con_margin, nil);
          LineTo(BordersBox.Canvas.Handle, BordersBox.Width - con_margin, con_margin);
        end;
      2:
        begin
          MoveToEx(BordersBox.Canvas.Handle, con_margin, BordersBox.Height div 2, nil);
          LineTo(BordersBox.Canvas.Handle, BordersBox.Width - con_margin, BordersBox.Height div 2);
        end;
      3:
        begin
          MoveToEx(BordersBox.Canvas.Handle, con_margin, BordersBox.Height - con_margin, nil);
          LineTo(BordersBox.Canvas.Handle, BordersBox.Width - con_margin, BordersBox.Height - con_margin);
        end;
      4:
        begin
          MoveToEx(BordersBox.Canvas.Handle, con_margin, con_margin, nil);
          LineTo(BordersBox.Canvas.Handle, con_margin, BordersBox.Height - con_margin);
        end;
      5:
        begin
          MoveToEx(BordersBox.Canvas.Handle, BordersBox.Width div 2, con_margin, nil);
          LineTo(BordersBox.Canvas.Handle, BordersBox.Width div 2, BordersBox.Height - con_margin);
        end;
      6:
        begin
          MoveToEx(BordersBox.Canvas.Handle, BordersBox.Width - con_margin, con_margin, nil);
          LineTo(BordersBox.Canvas.Handle, BordersBox.Width - con_margin, BordersBox.Height - con_margin);
        end;
    end;

    SelectObject(BordersBox.Canvas.Handle, OldH);
    DeleteObject(NewH);
  end;

  FBusy := False;
end;

procedure TRMCellPropForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if ModalResult = mrOK then
    SetControlState;
end;

end.