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

📄 unit1.pas

📁 Ehlib 4.14 full source for bds2006
💻 PAS
📖 第 1 页 / 共 3 页
字号:
procedure TForm1.bInpPreviewClick(Sender: TObject);
begin
  DBGridEh1.Visible := False;
  Panel1.Visible := False;
  PreviewBox1.Visible := True;
  PreviewSetupPanel.Visible := True;
  PreviewBox1.Printer.PrinterSetupOwner := DBGridEh1;
  PreviewBox1.Printer.OnPrinterSetupDialog := InplacePreviewSetupDialog;
  PrintDBGridEh1.DBGridEh := DBGridEh1;
  PrintDBGridEh1.PrintTo(PreviewBox1.Printer);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PreviewBox1.Align := alClient;
  Application.OnIdle := ApplicationIdle;
  FilterControlList := TStringList.Create;
//  FilterControlList.AddObject('VNo',Label1);
//  FilterControlList.AddObject('VName1',DBLookupComboboxEh1);
//  FilterControlList.AddObject('PDescription',DBLookupComboboxEh2);
  DBDateTimeEditEh2.Value := Now;
end;

procedure TForm1.bPrintClick(Sender: TObject);
begin
  PreviewBox1.PrintDialog;
end;

procedure TForm1.bPrinterSetupClick(Sender: TObject);
begin
  PreviewBox1.PrinterSetupDialog;
end;

procedure TForm1.bPrevPageClick(Sender: TObject);
begin
  PreviewBox1.PageIndex := Pred(PreviewBox1.PageIndex);
end;

procedure TForm1.bStopClick(Sender: TObject);
begin
  PreviewBox1.Printer.Abort;
end;

procedure TForm1.PreviewBox1PrinterPreviewChanged(Sender: TObject);
begin
  bStop.Enabled := PreviewBox1.Printer.Printing;
  bClosePreview.Enabled := not PreviewBox1.Printer.Printing;
  bPrint.Enabled := not PreviewBox1.Printer.Printing;
  bPrinterSetup.Enabled := not PreviewBox1.Printer.Printing;
  bPrevPage.Enabled:=PreviewBox1.PageIndex>1;
  bNextPage.Enabled:=PreviewBox1.PageIndex<PreviewBox1.PageCount;
  lPageInfo.Caption := 'Page '+IntToStr(PreviewBox1.PageIndex)+' of '+IntToStr(PreviewBox1.PageCount);
end;

procedure TForm1.bClosePreviewClick(Sender: TObject);
begin
    PreviewBox1.Visible := False;
    PreviewSetupPanel.Visible := False;
    Panel1.Visible := True;
    DBGridEh1.Visible := True;
end;

procedure TForm1.bNextPageClick(Sender: TObject);
begin
  PreviewBox1.PageIndex := Succ(PreviewBox1.PageIndex);
end;


procedure TForm1.InplacePreviewSetupDialog(Sender: TObject);
begin
  PreviewBox1.Printer.OnPrinterSetupDialog := InplacePreviewSetupDialog;
  PreviewBox1.Printer.PrinterSetupOwner := DBGridEh1;
  if PrintDBGridEh1.PrinterSetupDialog then
    PrintDBGridEh1.PrintTo(PreviewBox1.Printer);
end;

procedure TForm1.cCustomPreviewClick(Sender: TObject);
{$IFDEF CIL}
{$ELSE}
var
  FormImage: TBitmap;
  Info: PBitmapInfo;
  InfoSize: DWORD;
  Image: Pointer;
  ImageSize: DWORD;
  Bits: HBITMAP;
  DIBWidth, DIBHeight: Longint;
  PrintWidth, PrintHeight: Longint;
  StdPrinterPreview:TPrinterPreview;
  i:Integer;
{$ENDIF}
begin
{$IFDEF CIL}
{$ELSE}
  StdPrinterPreview := SetPrinterPreview(fCustomPreview.PreviewBox1.Printer);
  try
  PrinterPreview.BeginDoc;
  try
    i := 0;
    while True do begin
      PageControl1.ActivePage := PageControl1.Pages[i];
      FormImage := GetFormImage;
      Canvas.Lock;
      try
        { Paint bitmap to the printer }
        with PrinterPreview, Canvas do
        begin
          Bits := FormImage.Handle;
          GetDIBSizes(Bits, InfoSize, ImageSize);
          Info := AllocMem(InfoSize);
          try
            Image := AllocMem(ImageSize);
            try
              GetDIB(Bits, 0, Info^, Image^);
              with Info^.bmiHeader do
              begin
                DIBWidth := biWidth;
                DIBHeight := biHeight;
              end;
              case PrintScale of
                poProportional:
                  begin
                    PrintWidth := MulDiv(DIBWidth, GetDeviceCaps(Printer.Handle,
                      LOGPIXELSX), PixelsPerInch);
                    PrintHeight := MulDiv(DIBHeight, GetDeviceCaps(Printer.Handle,
                      LOGPIXELSY), PixelsPerInch);
                  end;
                poPrintToFit:
                  begin
                    PrintWidth := MulDiv(DIBWidth, PagEheight, DIBHeight);
                    if PrintWidth < PageWidth then
                      PrintHeight := PagEheight
                    else
                    begin
                      PrintWidth := PageWidth;
                      PrintHeight := MulDiv(DIBHeight, PageWidth, DIBWidth);
                    end;
                  end;
              else
                PrintWidth := DIBWidth;
                PrintHeight := DIBHeight;
              end;
              StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
                DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
            finally
              FreeMem(Image, ImageSize);
            end;
          finally
            FreeMem(Info, InfoSize);
          end;
        end;
      finally
        Canvas.Unlock;
        FormImage.Free;
      end;
      Inc(i);
      if PageControl1.PageCount = i then Exit;
      PrinterPreview.NewPage;
    end;
  finally
    PrinterPreview.EndDoc;
  end;
  finally
    SetPrinterPreview(StdPrinterPreview);
    PageControl1.ActivePage := PageControl1.Pages[0];
  end;
{$ENDIF}
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
var mi:TMenuItem;
    S:String;
    p:Integer;
  function GetBackCharPos(S:String; C:Char; N:Integer):Integer;
  var i:Integer;
  begin
    Result := 1;
    for i := Length(S) downto 1 do
      if S[i] = C then begin
        Dec(N);
        if N = 0 then begin
          Result := i+1;
          Exit;
        end;
      end;
  end;
  type
    TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

  function StringReplace(const S, OldPattern, NewPattern: string;
    Flags: TReplaceFlags): string;
  var
    SearchStr, Patt, NewStr: string;
    Offset: Integer;
  begin
    if rfIgnoreCase in Flags then
    begin
      SearchStr := AnsiUpperCase(S);
      Patt := AnsiUpperCase(OldPattern);
    end else
    begin
      SearchStr := S;
      Patt := OldPattern;
    end;
    NewStr := S;
    Result := '';
    while SearchStr <> '' do
    begin
     Offset := AnsiPos(Patt, SearchStr);
      if Offset = 0 then
      begin
        Result := Result + NewStr;
        Break;
      end;
      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
      NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
      if not (rfReplaceAll in Flags) then
      begin
        Result := Result + NewStr;
        Break;
      end;
     SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
    end;
  end;
begin
  mi := TMenuItem.Create(nil);
  with DBGridEh1.VisibleColumns do begin
    S := Items[Count-1].Title.Caption;
    p := GetBackCharPos(S,'|',2);
    S := Copy(S,p,Length(S));
    mi.Caption := StringReplace(S,'|',#9,[rfReplaceAll]);
{$IFDEF CIL}
    mi.Tag := Variant(Items[Count-1]);
{$ELSE}
    mi.Tag := Integer(Items[Count-1]);
{$ENDIF}
    mi.OnClick := ColumnMenuItem;
  end;
  pmNoVisibleCols.Items.Insert(0,mi);
  DBGridEh1.VisibleColumns.Items[DBGridEh1.VisibleColumns.Count-1].Visible := False;
  if (DBGridEh1.VisibleColumns.Count = 0) then ToolButton2.Enabled := False;
  ToolButton1.Enabled := True;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  pmNoVisibleCols.Items[0].Free;
  DBGridEh1.Columns[DBGridEh1.VisibleColumns.Count].Visible := True;
  if (DBGridEh1.Columns.Count = DBGridEh1.VisibleColumns.Count) then
    ToolButton1.Enabled := False;
  ToolButton2.Enabled := True;
end;

procedure TForm1.ColumnMenuItem(Sender: TObject);
begin
  TColumnEh(TMenuItem(Sender).Tag).Index := DBGridEh1.VisibleColumns.Count;
  TColumnEh(TMenuItem(Sender).Tag).Visible := True;
  Sender.Free;
  if (DBGridEh1.Columns.Count = DBGridEh1.VisibleColumns.Count) then
    ToolButton1.Enabled := False;
end;

function TForm1.GridSelectionAsText(AGrid: TDBGridEh): String;
var //bm:TBookmarkStr;
    i,j :Integer;
    ss: TStringStream;
    function StringTab(s:String; Index, Count:Integer):String;
    begin
      if Index <> Count then
        Result := s + #09
      else
        Result := s;
    end;
begin
  Result := '';
  with AGrid do begin
    if Selection.SelectionType = gstNon then Exit;
    ss := TStringStream.Create('');
    with Datasource.Dataset do
    try
      // BM := Bookmark;
      SaveBookmark;
      DisableControls;
      try
        case Selection.SelectionType of
          gstRecordBookmarks:
          begin
            for I := 0 to Selection.Rows.Count-1 do
            begin
              Bookmark := Selection.Rows[I];
              for j := 0 to VisibleColumns.Count - 1 do
                ss.WriteString(StringTab(VisibleColumns[j].DisplayText,j,VisibleColumns.Count - 1));
              ss.WriteString(#13#10);
            end;
          end;
          gstRectangle: begin
             Bookmark := Selection.Rect.TopRow;
             while True do begin
               for j := Selection.Rect.LeftCol to Selection.Rect.RightCol do
                 if Columns[j].Visible then
                   ss.WriteString(StringTab(Columns[j].DisplayText,j,Selection.Rect.RightCol));
               if DataSetCompareBookmarks(Datasource.Dataset,Selection.Rect.BottomRow,Bookmark) = 0 then Break;
               Next;
               if Eof then Break;
               ss.WriteString(#13#10);
             end;
          end;
          gstColumns: begin
             for j := 0 to Selection.Columns.Count-1 do
                 ss.WriteString(StringTab(Selection.Columns[j].Title.Caption,j,Selection.Columns.Count-1));
             ss.WriteString(#13#10);
             First;
             while  EOF = False do begin
               for j := 0 to Selection.Columns.Count-1 do
                 ss.WriteString(StringTab(Selection.Columns[j].DisplayText,j,Selection.Columns.Count-1));
               ss.WriteString(#13#10);
               Next;
             end;
             for i := 0 to FooterRowCount-1 do begin
               for j := 0 to Selection.Columns.Count-1 do
                   ss.WriteString(StringTab(GetFooterValue(i,Selection.Columns[j]),j,Selection.Columns.Count-1));
               ss.WriteString(#13#10);
             end;
          end;
          gstAll: begin
             for j := 0 to VisibleColumns.Count-1 do
                 ss.WriteString(StringTab(VisibleColumns[j].Title.Caption,j,VisibleColumns.Count-1));
             ss.WriteString(#13#10);
             First;
             while  EOF = False do begin
               for j := 0 to VisibleColumns.Count-1 do
                 ss.WriteString(StringTab(VisibleColumns[j].DisplayText,j,VisibleColumns.Count-1));
               ss.WriteString(#13#10);
               Next;
             end;
             for i := 0 to FooterRowCount-1 do begin
               for j := 0 to VisibleColumns.Count-1 do
                   ss.WriteString(StringTab(GetFooterValue(i,VisibleColumns[j]),j,VisibleColumns.Count-1));
               ss.WriteString(#13#10);
             end;
          end;
        end;
        Result := ss.DataString;
      finally
        //Bookmark := BM;
        RestoreBookmark;
        EnableControls;
      end;
    finally
      ss.Free;

⌨️ 快捷键说明

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