utxtfrm.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

  fi: TFontInfo;
  idx, ctsn: Integer;
  FCharCode:word;
  FFontName:string;
  FCharset:TFontCharSet;
begin
  frm:=TfrmRVInsertSymbol.Create(nil);
  if frm.ShowModal=mrok then
  begin
    frm.GetInfo(FCharCode, FFontName, FCharset);
    fi := TFontInfo.Create(nil);
    ctsn := RichEdit.CurTextStyleNo;
    fi.Assign(RichEdit.Style.TextStyles[ctsn]);
    fi.FontName := FFontName;
    fi.Charset := FCharset;
    fi.Unicode := true;//(FCharset = DEFAULT_CHARSET);
    fi.Protection := fi.Protection+[rvprDoNotAutoSwitch];
    fi.Standard := False;
    idx := RichEdit.Style.TextStyles.FindSuchStyle(ctsn, fi, RVAllFontInfoProperties);
    if idx<0 then begin
      RichEdit.Style.TextStyles.Add.Assign(fi);
      idx := RichEdit.Style.TextStyles.Count-1;
    end;
    RichEdit.CurTextStyleNo := idx;
    if fi.Unicode then
      RichEdit.InsertTextW(WideChar(FCharCode))
    else
      RichEdit.InsertText(Chr(FCharCode));
    RichEdit.CurTextStyleNo := ctsn;
    fi.Free;
  end; 
  frm.Free;
end;

procedure TTxtFrm.FormCreate(Sender: TObject);
begin
  cbFontItem.Strings:=Screen.Fonts;
  cds:=TClientDataSet.Create(nil);
  AddImages(ImageList2,FaceArray);
end;

procedure TTxtFrm.cbFontItemAcceptText(Sender: TObject;
  var NewText: String; var Accept: Boolean);
begin

  if TTBXComboBoxItem(sender).Strings.IndexOf(NewText)<>-1 then
  begin
    FontName:=NewText;
    FontSize:=StrToIntDef(NewText,9);
    RichEdit.ApplyStyleConversion(TControl(sender).Tag);
    RichEdit.SetFocus;
    Accept:=true;
  end
  else
    Accept:=false;
end;

procedure TTxtFrm.cbFontItemItemClick(Sender: TObject);
begin
  FontName:=cbFontItem.Text;
  FontSize:=StrToIntDef(cbFontSize.Text,9);
  RichEdit.ApplyStyleConversion(TControl(sender).Tag);
  RichEdit.SetFocus;
end;

procedure TTxtFrm.RichEditStyleConversion(Sender: TCustomRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
var
  FontInfo: TFontInfo;  
begin
  FontInfo := TFontInfo.Create(nil);
  try
    FontInfo.Assign(RVStyle1.TextStyles[StyleNo]);
    case UserData of
      0:
      begin
        FontInfo.FontName:=FontName;
      end;
      1:
      begin
        FontInfo.Size:=FontSize;
      end;
      2:
      begin
        FontInfo.Color:=TheColor;
      end;
      3:
      begin
        if SpTBXItem5.Checked then
          FontInfo.Style := FontInfo.Style+[fsBold]
        else
          FontInfo.Style := FontInfo.Style-[fsBold];
      end;
      4:
      begin
        if SpTBXItem4.Checked then
          FontInfo.Style := FontInfo.Style+[fsItalic]
        else
          FontInfo.Style := FontInfo.Style-[fsItalic];
      end;
      5:
      begin
        if SpTBXItem3.Checked then
          FontInfo.Style := FontInfo.Style+[fsUnderline]
        else
          FontInfo.Style := FontInfo.Style-[fsUnderline];
      end;
    end;
    NewStyleNo := RVStyle1.TextStyles.FindSuchStyle(StyleNo,FontInfo,RVAllFontInfoProperties);
    if NewStyleNo=-1 then
    begin
      RVStyle1.TextStyles.Add;
      NewStyleNo := RVStyle1.TextStyles.Count-1;
      RVStyle1.TextStyles[NewStyleNo].Assign(FontInfo);
      RVStyle1.TextStyles[NewStyleNo].Standard := False;
    end;
  finally
    FontInfo.Free;
  end;
end;

procedure TTxtFrm.RichEditCurTextStyleChanged(Sender: TObject);
var
  fi: TFontInfo;
begin
  fi:=RichEdit.Style.TextStyles[RichEdit.CurTextStyleNo];
  cbFontItem.ItemIndex:=cbFontItem.Strings.IndexOf(fi.FontName);
  cbFontSize.ItemIndex:=cbFontSize.Strings.IndexOf(inttostr(fi.Size));
  SpTBXItem5.Checked:= fsBold in fi.Style;
  SpTBXItem4.Checked:= fsItalic in fi.Style;
  SpTBXItem3.Checked:= fsUnderline in fi.Style;
end;

procedure TTxtFrm.TBXSubmenuItem1DrawImage(Item: TTBCustomItem;
  Viewer: TTBItemViewer; Canvas: TCanvas; ImageRect: TRect;
  ImageOffset: TPoint; StateFlags: Integer);
var
  //DC: HDC;
  Color: TColor;
begin
  //DC := Canvas.Handle;
  if not Boolean(StateFlags and ISF_DISABLED) then
  begin
    Color := TBXColorPalette1.Color;
    OffsetRect(ImageRect, ImageOffset.X, ImageOffset.Y);
    ImageRect.Top := ImageRect.Bottom - 4;
    if Color <> clNone then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(ImageRect);
    end
    else
    begin
      Canvas.Brush.Color := Clblack;
      Canvas.FillRect(ImageRect);
      //FrameRectEx(DC, ImageRect, clBtnShadow, True);
      //DitherRect(DC, ImageRect, clBtnFace, clBtnShadow);
    end;
  end;
end;

procedure TTxtFrm.TBXColorPalette1Change(Sender: TObject);
begin
  TBXSubmenuItem1.Invalidate;
  TheColor:=TBXColorPalette1.Color;
  RichEdit.ApplyStyleConversion(2);
  TBXColorItem1.Checked:=false;
end;

procedure TTxtFrm.RichEditParaStyleConversion(Sender: TCustomRichViewEdit;
  StyleNo, UserData: Integer; AppliedToText: Boolean;
  var NewStyleNo: Integer);
var
  ParaInfo: TParaInfo;
begin
  ParaInfo := TParaInfo.Create(nil);
  try
    ParaInfo.Assign(RVStyle1.ParaStyles[StyleNo]);
    case UserData of
      0:
      begin
        ParaInfo.Alignment := rvaLeft;
      end;
      1:
      begin
        ParaInfo.Alignment := rvaCenter;
      end;
      2:
      begin
        ParaInfo.Alignment := rvaRight;
      end;
      3:
      begin
        ParaInfo.Background.Color:=TheBackColor;  
      end;
      4:
      begin
        if not SpTBXItem27.Checked then
          ParaInfo.Options := ParaInfo.Options + [rvpaoNoWrap]
        else
          ParaInfo.Options := ParaInfo.Options - [rvpaoNoWrap];
      end;
    end;
    NewStyleNo := RVStyle1.ParaStyles.FindSuchStyle(StyleNo,ParaInfo,RVAllParaInfoProperties);
    if NewStyleNo=-1 then
    begin
      RVStyle1.ParaStyles.Add;
      NewStyleNo := RVStyle1.ParaStyles.Count-1;
      RVStyle1.ParaStyles[NewStyleNo].Assign(ParaInfo);
      RVStyle1.ParaStyles[NewStyleNo].Standard := False;
    end;
  finally
    ParaInfo.Free;
  end;
end;

procedure TTxtFrm.SetParaStyle(style: integer);
begin
  RichEdit.ApplyParaStyleConversion(style);
end;

procedure TTxtFrm.RichEditCurParaStyleChanged(Sender: TObject);
var
  Alignment:TRVAlignment;
begin
  Alignment:=RVStyle1.ParaStyles[RichEdit.CurParaStyleNo].Alignment;
  SpTBXItem8.Checked:=Alignment=rvaLeft;
  SpTBXItem7.Checked:=Alignment=rvaCenter;
  SpTBXItem6.Checked:=Alignment=rvaRight;

  SpTBXItem27.Checked := not (rvpaoNoWrap in RichEdit.style.ParaStyles[RichEdit.CurParaStyleNo].Options);
end;

procedure TTxtFrm.SpTBXItem2Click(Sender: TObject);
begin
  cd.Color := RVStyle1.TextStyles[RichEdit.CurTextStyleNo].Color;
  if cd.Execute then
  begin
    TheColor:=cd.Color;
    TBXColorPalette1.Color:=cd.Color;
    RichEdit.ApplyStyleConversion(2);
    TBXColorItem1.Checked:=false;
  end;
end;

procedure TTxtFrm.TBXColorItem1Click(Sender: TObject);
begin
  TBXColorPalette1.Color:=TBXColorItem1.Color;
  TheColor:=TBXColorItem1.Color;
  TBXSubmenuItem1.Invalidate;
  RichEdit.ApplyStyleConversion(2);
  TBXColorItem1.Checked:=true;
end;

procedure TTxtFrm.AfterInitData;
var
  fi: TFontInfo;
begin
  inherited;
  fi:=RichEdit.Style.TextStyles[RichEdit.CurTextStyleNo];
  TBXColorPalette1.Color:=fi.Color;
  TBXColorItem1.Color:=clNone;
  TBXSubmenuItem1.Invalidate;

  TBXColorPalette2.Color:=RVStyle1.ParaStyles[Richedit.CurParaStyleNo].Background.Color;
  TBXColorItem2.Color:=clNone;
  TBXSubmenuItem2.Invalidate;

  RichEditCurParaStyleChanged(nil);
  RichEditCurTextStyleChanged(nil);
  RichEdit.Modified:=false;   
end;

procedure TTxtFrm.SpTBXItem8Click(Sender: TObject);
begin
  SpTBXItem8.Checked:=true;
  SetAlignmentLeft;
end;

procedure TTxtFrm.SpTBXItem7Click(Sender: TObject);
begin
  SpTBXItem7.Checked:=true;
  SetAlignmentCenter;
end;

procedure TTxtFrm.SpTBXItem6Click(Sender: TObject);
begin
  SpTBXItem6.Checked:=true;
  SetAlignmentRight;
end;

procedure TTxtFrm.SetAlignmentLeft;
begin
  SetParaStyle(0);
end;

procedure TTxtFrm.SetAlignmentCenter;
begin
  SetParaStyle(1);
end;

procedure TTxtFrm.SetAlignmentRight;
begin
  SetParaStyle(2);
end;

procedure TTxtFrm.SpTBXItem5Click(Sender: TObject);
begin
  SpTBXItem5.Checked:=not SpTBXItem5.Checked;
  RichEdit.ApplyStyleConversion(3);
end;

procedure TTxtFrm.SpTBXItem4Click(Sender: TObject);
begin
  SpTBXItem4.Checked:=not SpTBXItem4.Checked;
  RichEdit.ApplyStyleConversion(4);
end;

procedure TTxtFrm.SpTBXItem3Click(Sender: TObject);
begin
  SpTBXItem3.Checked:=not SpTBXItem3.Checked;
  RichEdit.ApplyStyleConversion(5); 
end;

procedure TTxtFrm.TBXColorPalette2Change(Sender: TObject);
begin
  TBXSubmenuItem2.Invalidate;
  TheBackColor:=TBXColorPalette2.Color;
  Richedit.ApplyParaStyleConversion(3);
end;

procedure TTxtFrm.TBXColorItem2Click(Sender: TObject);
begin
  TBXColorPalette2.Color:=TBXColorItem2.Color;
  TheBackColor:=TBXColorItem2.Color;
  TBXSubmenuItem2.Invalidate;
  Richedit.ApplyParaStyleConversion(3);
  TBXColorItem2.Checked:=true;
end;

procedure TTxtFrm.SpTBXItem9Click(Sender: TObject);
begin
  cd.Color := RVStyle1.ParaStyles[RichEdit.CurParaStyleNo].Background.Color;
  if cd.Execute then
  begin
    TheBackColor:=cd.Color;
    TBXColorPalette2.Color:=cd.Color;
    Richedit.ApplyParaStyleConversion(3);
    TBXColorItem2.Checked:=false;
  end;
end;

procedure TTxtFrm.Setcds(const Value: TClientDataSet);
begin
  Fcds := Value;
end;

procedure TTxtFrm.InsAccessories;
var
  MFile:TStream;
  FileName:string;
  FileID,i:integer;
  DlgOpen:TOpenDialog;
begin
  DlgOpen:=TOpenDialog.Create(nil);
  try
    DlgOpen.Title:='插入附件';
    DlgOpen.Filter:='All Files|*.*';
    if DlgOpen.Execute then
    begin
      //self.Update;
      MFile:=TMemoryStream.Create;
      TMemoryStream(MFile).LoadFromFile(DlgOpen.FileName);
      FileName:=ExtractFileName(DlgOpen.FileName);
      FileID:=-1;
      for i:=0 to mAcc.Count-1 do
      begin
        if mAcc.Items[i].Tag>=FileID then
          FileID:=mAcc.Items[i].Tag+1;
      end;

      if FileID>-1 then
      begin
        OprList.InsAccessories(MFile,ID,FileID,FileName);
        CreateItem(FileName,FileID);
        mAcc.Tag:=mAcc.Tag+1;
        mAcc.Caption:='共有'+inttostr(mAcc.Tag)+'个附件';
      end;
      freeandnil(MFile);
      MFile.Free;
    end;
  finally
    DlgOpen.Free;
  end;
end;

procedure TTxtFrm.CreateItem(Acaption: string; Atag: integer);
var
  Item:TSpTBXSubmenuItem;
  SubItem:TSpTBXItem;
begin
  Item:=TSpTBXSubmenuItem.Create(nil);
  Item.Caption:=ACaption;
  Item.Tag:=ATag;
  mAcc.Insert(0,Item);

  SubItem:=TSpTBXItem.Create(nil);
  SubItem.Caption:='另存为...';
  SubItem.Tag:=ATag;
  SubItem.Hint:=ACaption;
  SubItem.OnClick:=DoOnItemClick;
  Item.Add(SubItem);

  SubItem:=TSpTBXItem.Create(nil);
  SubItem.Caption:='删除';
  SubItem.Tag:=ATag;
  SubItem.Hint:=ACaption;
  SubItem.OnClick:=DoOnItemDelete;
  Item.Add(SubItem);
end;

procedure TTxtFrm.DoOnItemClick(sender: TObject);
var
  Bin:TMemoryStream;
  DlgSave:TSaveDialog;
begin
  DlgSave:=TSaveDialog.Create(nil);
  try
    DlgSave.Title:='保存附件';
    DlgSave.FileName:=TSpTBXItem(Sender).Hint;
    if DlgSave.Execute then
    begin
      //self.Update;
      Bin:=TMemoryStream.Create;
      try