⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 aligrid.pas

📁 一个STRINGGRID 控件,比原DELPHI自带的STRINGGRID 功能强大
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  font.free;
  selfont.free;
  inherited destroy;
  end;
(*@\\\000000060F*)
(*@/// procedure TCellProperties.assign(value:TCellProperties); *)
procedure TCellProperties.assign(value:TCellProperties);
begin
  if value=NIL then begin
    align:=aldefault;
    wordwrap:=ww_default;
    editable:=0;
    brush:=NIL;
    selbrush:=NIL;
    font:=NIL;
    selfont:=NIL;
    end
  else begin
    align:=value.align;
    wordwrap:=value.wordwrap;
{     copy_brush(f_brush,value.brush); }
{     copy_brush(f_selbrush,value.selbrush); }
{     copy_font(f_font,value.font); }
{     copy_font(f_selfont,value.selfont); }
    Brush:=value.brush;
    SelBrush:=value.selbrush;
    font:=value.font;
    Selfont:=value.selfont;
    editable:=value.editable;
    end;
  end;
(*@\\\0000001601*)
(*@/// procedure TCellProperties.SetFont(value: TFont); *)
procedure TCellProperties.SetFont(value: TFont);
begin
  copy_font(f_font,value);
  if f_font<>NIL then begin
    f_font.OnChange:=f_grid.FontChanged;
    if value is TMyFont then
      TMyFont(f_font).HasChanged:=TMyFont(value).HasChanged
    else
      TMyFont(f_font).HasChanged:=true;
    end;
  end;
(*@\\\0000000927*)
(*@/// procedure TCellProperties.SetSelFont(value: TFont); *)
procedure TCellProperties.SetSelFont(value: TFont);
begin
  copy_font(f_selfont,value);
  if f_selfont<>NIL then begin
    f_selfont.OnChange:=f_grid.FontChanged;
    if value is TMyFont then
      TMyFont(f_selfont).HasChanged:=TMyFont(value).HasChanged
    else
      TMyFont(f_selfont).HasChanged:=true;
    end;
  end;
(*@\\\0000000901*)
(*@/// procedure TCellProperties.SetBrush(value: TBrush); *)
procedure TCellProperties.SetBrush(value: TBrush);
begin
  copy_brush(f_brush,value);
  if f_brush<>NIL then begin
    f_brush.OnChange:=f_grid.BrushChanged;
    if value is TMyBrush then
      TMyBrush(f_Brush).HasChanged:=TMyBrush(value).HasChanged
    else
      TMyBrush(f_Brush).HasChanged:=true;
    end;
  end;
(*@\\\0000000929*)
(*@/// procedure TCellProperties.SetSelBrush(value: TBrush); *)
procedure TCellProperties.SetSelBrush(value: TBrush);
begin
  copy_brush(f_selbrush,value);
  if f_selbrush<>NIL then begin
    f_selbrush.OnChange:=f_grid.BrushChanged;
    if value is TMyBrush then
      TMyBrush(f_selBrush).HasChanged:=TMyBrush(value).HasChanged
    else
      TMyBrush(f_selBrush).HasChanged:=true;
    end;
  end;
(*@\\\000000092C*)
(*@/// function TCellProperties.isempty: boolean; *)
function TCellProperties.isempty: boolean;
begin
  result:=(align=aldefault) and (wordwrap=ww_default) and
          (font=NIL) and (selfont=NIL) and
          (brush=NIL) and (selbrush=NIL) and
          (editable=0);
  end;
(*@\\\0000000601*)
(*@/// function TCellProperties.clone:TCellProperties; *)
function TCellProperties.clone:TCellProperties;
begin
  result:=TCellProperties.Create(self.f_grid);
  result.assign(self);
  end;
(*@\\\0000000301*)

(*@/// procedure TCellProperties.WriteToWriter(writer:TWriter); *)
procedure TCellProperties.WriteToWriter(writer:TWriter);
begin
  (*@/// if self.align<>aldefault     then *)
  if self.align<>aldefault then begin
    writer.writeinteger(prop_align);
    writer.writeinteger(byte(self.align));
    end;
  (*@\\\*)
  (*@/// if self.wordwrap<>ww_default then *)
  if self.wordwrap<>ww_default then begin
    writer.writeinteger(prop_wrap);
    writer.writeinteger(byte(self.wordwrap));
    end;
  (*@\\\*)
  (*@/// if self.editable<>0          then *)
  if self.editable<>0 then begin
    writer.writeinteger(prop_edit);
    writer.writeinteger(self.editable);
    end;
  (*@\\\*)
  (*@/// if self.brush<>NIL           then *)
  if self.brush<>NIL then begin
    writer.writeinteger(prop_brush);
    WriteBrush(writer,self.brush);
    end;
  (*@\\\*)
  (*@/// if self.selbrush<>NIL        then *)
  if self.selbrush<>NIL then begin
    writer.writeinteger(prop_selbrush);
    WriteBrush(writer,self.selbrush);
    end;
  (*@\\\*)
  (*@/// if self.Font<>NIL            then *)
  if self.Font<>NIL then begin
    writer.writeinteger(prop_Font);
    WriteFont(writer,self.Font);
    end;
  (*@\\\*)
  (*@/// if self.selFont<>NIL         then *)
  if self.selFont<>NIL then begin
    writer.writeinteger(prop_selFont);
    WriteFont(writer,self.selFont);
    end;
  (*@\\\*)
  writer.writeinteger(prop_end);
  end;
(*@\\\0000000B01*)
(*@/// procedure TCellProperties.ReadFromReader(Reader:TReader; grid:TStringAlignGrid); *)
procedure TCellProperties.ReadFromReader(Reader:TReader; grid:TStringAlignGrid);
var
  k: integer;
begin
  repeat
    k:=Reader.ReadInteger;
    ReadSingleProperty(k,reader,grid);
  until k=prop_end;
  end;
(*@\\\000000030E*)
(*@/// procedure TCellProperties.ReadSingleProperty(Proptype:integer; Reader:TReader; grid:TStringAlignGrid); *)
procedure TCellProperties.ReadSingleProperty(Proptype:integer; Reader:TReader; grid:TStringAlignGrid);
var
  v: TBrush;
  f: TFont;
begin
  case proptype of
    prop_end     : ;
    prop_align   : self.align:=TMyAlign(reader.readinteger);
    prop_wrap    : self.wordwrap:=T_Wordwrap(reader.readinteger);
    prop_edit    : self.editable:=reader.readinteger;
    (*@/// prop_brush   : self.brush:=ReadBrush(Reader); *)
    prop_brush   : begin
      v:=NIL;
      try
        v:=ReadBrush(Reader);
        self.brush:=v;
        self.brush.OnChange:=grid.brushchanged;
      finally
        v.free;
        end;
      end;
    (*@\\\0000000621*)
    (*@/// prop_selbrush: self.selbrush:=ReadBrush(Reader); *)
    prop_selbrush   : begin
      v:=NIL;
      try
        v:=ReadBrush(Reader);
        self.selbrush:=v;
        self.selbrush.OnChange:=grid.brushchanged;
      finally
        v.free;
        end;
      end;
    (*@\\\0000000624*)
    (*@/// prop_font    : self.font:=ReadFont(Reader); *)
    prop_font   : begin
      f:=NIL;
      try
        f:=ReadFont(Reader);
        self.font:=f;
        self.font.OnChange:=grid.fontchanged;
      finally
        f.free;
        end;
      end;
    (*@\\\0000000620*)
    (*@/// prop_selfont : self.selfont:=ReadFont(Reader); *)
    prop_selfont   : begin
      f:=NIL;
      try
        f:=ReadFont(Reader);
        self.selfont:=f;
        self.selfont.OnChange:=grid.fontchanged;
      finally
        f.free;
        end;
      end;
    (*@\\\0000000623*)
    end;
  end;
(*@\\\0000000E01*)
(*@\\\0000001501*)

(*@/// TMyFont              = class(TFont)            // To remember if changed *)
{ TMyFont }
(*@/// procedure TMyFont.Changed; *)
procedure TMyFont.Changed;
begin
  HasChanged:=true;
  inherited changed;
  end;
(*@\\\*)
(*@\\\0000000201*)
(*@/// TMyBrush             = class(TBrush)           // To remember if changed *)
{ TMyBrush }
(*@/// procedure TMyBrush.Changed; *)
procedure TMyBrush.Changed;
begin
  HasChanged:=true;
  inherited changed;
  end;
(*@\\\*)
(*@\\\*)
(*@/// TNewInplaceEdit      = class(TInplaceEdit)     // The internal cell editor *)
{ TNewInplaceEdit }
(*@/// procedure TNewInplaceEdit.CreateParams(var Params: TCreateParams); *)
procedure TNewInplaceEdit.CreateParams(var Params: TCreateParams);
(*$ifdef delphi_ge_4 *)
const
  Alignments : array[TMyAlign] of longword = (ES_RIGHT,ES_LEFT,ES_CENTER,ES_RIGHT);
(*$else *)
const
  Alignments : array[TMyAlign] of Longint = (ES_RIGHT,ES_LEFT,ES_CENTER,ES_RIGHT);
(*$endif *)
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style
{     and (not ES_MULTILINE)    (* otherwise the passwordchar won't work *) }
{                               (* but makes it behave erratically *)       }
    or Alignments[FAlignment];
  end;
(*@\\\0000000B01*)
(*@/// procedure TNewInplaceEdit.SetAlignment(Value: TMyAlign); *)
procedure TNewInplaceEdit.SetAlignment(Value: TMyAlign);
var
  start,stop: integer;
{   Loc: TRect; }
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    GetSel(start,stop);
    RecreateWnd;
    SetSel(start,stop);
    UpdateLoc(TStringGrid(parent).CellRect(Col, Row));
    end;
  end;
(*@\\\*)
(*@/// constructor TNewInplaceEdit.Create(AOwner:TComponent); *)
constructor TNewInplaceEdit.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FAlignment := alLeft;
  end;
(*@\\\*)
(*@/// procedure TNewInplaceEdit.KeyPress(var Key: Char); *)
procedure TNewInplaceEdit.KeyPress(var Key: Char);
begin
  if (col=-1) or (row=-1) then key:=#0;
  if (key=#13) then begin
    if not f_multiline then
      postmessage(TStringAlignGrid(self.owner).handle,cn_edit_return,col,row)
    else if f_multiline then
      if not TStringAlignGrid(self.owner).CanEditModify then
        Key := #0;
    end;
  if (key=#27) and not f_multiline then begin
    self.text:=oldtext;
    postmessage(TStringAlignGrid(self.owner).handle,cn_edit_cancel,col,row);
    key:=#13;
    end;
  if key=#9 then  key:=#0;
  inherited KeyPress(key);
  end;
(*@\\\0000001201*)
(*@/// procedure TNewInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState); *)
procedure TNewInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if f_multiline and (key in
    [VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT,VK_LEFT,
     VK_RIGHT, VK_HOME, VK_END]) then
    { ignore it }
  else  inherited KeyDown(Key, Shift);
end;
(*@\\\*)
(*@/// procedure TNewInplaceEdit.UpdateContents; *)
procedure TNewInplaceEdit.UpdateContents;
var
  g: TStringAlignGrid;
begin
(*$ifdef delphi_1 *)
  Text := '';
  EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
  Text := Grid.GetEditText(Grid.Col, Grid.Row);
  MaxLength := Grid.GetEditLimit;
(*$else *)
  inherited UpdateContents;
(*$endif *)
  g:=grid as TStringAlignGrid;
  Col:=g.Col;
  Row:=g.Row;
  Alignment:=G.GetAlignCell(Col,Row);
  Font:=G.GetFontCellComplete(Col,Row);
  Color:=G.ColorCell[Col,Row];
  MultiLine:=G.EditMultiline;
  (*$ifdef delphi_ge_3 *)
  ImeMode:=g.ImeMode;
  ImeName:=g.ImeName;
  (*$endif *)
  end;
(*@\\\000000140D*)
(*$ifdef delphi_1 *)
(*@/// function TNewInplaceEdit.GetGrid:TCustomGrid; *)
function TNewInplaceEdit.GetGrid:TCustomGrid;
begin
  result:=parent as TCustomGrid;
  end;
(*@\\\0000000119*)
(*$endif *)
(*@/// procedure TNewInplaceEdit.WMWindowPosChanged(var Message: TMessage); *)
procedure TNewInplaceEdit.WMWindowPosChanged(var Message: TMessage);
begin
  inherited;
  end;
(*@\\\*)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -