Ir para conteúdo
Fórum Script Brasil
  • 0

Checklistbox Erro.

Eder

Perguntado por Eder,

 Share

Pergunta

Eder

Eder

Postado
Postado

Ola...

alguém poderia me dizer que erro é este???[Error] Unit1.pas(54): Undeclared identifier: 'Count'

procedure TForm1.Button1Click(Sender: TObject);

Var I : Integer;

begin

for I:= 0 to CheckListBox1.Count - 1 do

begin

if CheckListBox1.Checkedthen

DBGrid1.Columns.Visible := True

else

DBGrid1.Columns.Visible := False;

end;

end;

Meu Uses está assim:

uses

Windows, dbiprocs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Db, DBTables, Grids, DBGrids, StdCtrls, CheckLst;

Grato

Link para o comentário
Compartilhar em outros sites

15 respostass a esta questão

Posts Recomendados

  • 0
Micheus

Micheus

Postado
Postado

É estranho mesmo, porque eu utilizo sem problemas.

Só para desencardo de conciência, você já teclou F1 sobre este componente para ver se na versão 4, este campo por acaso estaria em outro lugar (tipo algo como Items.Count) ou com outro nome?

Outra coisa, já que você pegou o código de um colega, faça então um favor a lógica: troque pelo código abaixo 

procedure TForm1.Button1Click(Sender: TObject);
Var I : Integer;
begin
  for I := 0 to CheckListBox1.Count - 1 do
    DBGrid1.Columns[i].Visible := CheckListBox1.Checked[I];
end;

Esse negócio de fazer:

if TRUE then

TRUE

else

FALSE

me dá arrepios.... <_<

Link para o comentário
Compartilhar em outros sites
  • 0
Churc

Churc

Postado
Postado
Esse negócio de fazer:

if TRUE then

TRUE

else

FALSE

me dá arrepios.... <_<

Opa

AIUHEAU é verdade, então vamos explicar pro Eder

Seguinte Eder, no código veja só

if CheckListBox1.Checked then

DBGrid1.Columns.Visible := True

else

DBGrid1.Columns.Visible := False;

A propriedade Visible é Boolean e a propriedade Checked também, então

neste caso o ideal é você fazer:

DBGrid1.Columns.Visible := CheckListBox1.Checked;

Porque a coluna só vai estar visivel se o item estiver checado, então pra que

usar o IF?

E se caso você quisesse que a Coluna estivesse visivel "caso não" estivesse checado?

DBGrid1.Columns.Visible := not CheckListBox1.Checked;

E se a coluna estivesse visivel somente se o valor de i fosse igual a 10?

DBGrid1.Columns.Visible := i = 10;

Estas coisas simplificam muito o código...

abraços

Link para o comentário
Compartilhar em outros sites
  • 0
Eder

Eder

Postado
  • Autor
Postado

Micheus:

no meu delphi 4 funciona assim como você deu a dica:

for I:= 0 to CheckListBox1.Items.Count - 1 do
Churc...valeu a explicação ...alias obrigado aos dois Micheus e Churc.

Pessoal mudando a lógica, ficando o codigo assim:

procedure TForm1.Button1Click(Sender: TObject);

Var I : Integer;

begin

for I := 0 to CheckListBox1.Count - 1 do

DBGrid1.Columns.Visible := CheckListBox1.Checked;

end;

Só que tenho um pequeno problema....o codigo acima funciona perfeito, mas as vezes tenho que imprimir o conteudo deste dbgrid.

vocês usam como pra imprimir o conteudo de um DBGRID??

Eu uso o componente PrtGrid que tem uma propriedade chamada DBGRID que é ligado ao dbgrid usado....mas neste caso como a gente está trabalhando com o visible do dbgrid ele não entende e manda imprimir todos os campos da query. Mas eu preciso só imprimir os campos selecionados no codigo acima.

Se vocês tiverem uma ideia de como resolver este probleminha.

muito Grato...pessoal..mais uma vez..

t+

:D

Link para o comentário
Compartilhar em outros sites
  • 0
Micheus

Micheus

Postado
Postado
Só que tenho um pequeno problema....o codigo acima funciona perfeito, mas as vezes tenho que imprimir o conteudo deste dbgrid.

vocês usam como pra imprimir o conteudo de um DBGRID??

Eu imprimo as consultas através do QuickReport.

Eu uso o componente PrtGrid que tem uma propriedade chamada DBGRID que é ligado ao dbgrid usado....mas neste caso como a gente está trabalhando com o visible do dbgrid ele não entende e manda imprimir todos os campos da query. Mas eu preciso só imprimir os campos selecionados no codigo acima.

Se vocês tiverem uma ideia de como resolver este probleminha.

Como você adicionou os fields no seu DBGrid, então você está trabalhando com a propriedade Visible destas colunas, certo?!

Pois é, o tal do PrtGrid utiliza o DataSet ligado ao DBGrid, então para satisfazer suas necessidades (a dele) basta que além de trabalhar com a visibilidade da coluna, você trabalhe também com a do campo no dataset.

Isto deve resolver:

procedure TForm1.Button1Click(Sender: TObject);
Var I : Integer;
begin
  for I := 0 to CheckListBox1.Count - 1 do
  begin
    DBGrid1.Columns[i].Visible := CheckListBox1.Checked[I];
    DBGrid1.Columns[i].Field.Visible := DBGrid1.Columns[i].Visible;
  end;
end;

Observe que a propriedade Field corresponde exatamente ao campo lá no seu dataset. Então, talvez seja conveniente você marcar, na lista de fields do seu dataset, os campos que não irão aparecer nunca no seu DBGrid com Visible=False. Assim, você não corre o risco de ter algum outro campo impresso - além daqueles que estão adicionados ao seu DBGrid.

Testa aí...

Link para o comentário
Compartilhar em outros sites
  • 0
Eder

Eder

Postado
  • Autor
Postado (editado)
Pois é, o tal do PrtGrid utiliza o DataSet ligado ao DBGrid, então para satisfazer suas necessidades (a dele) basta que além de trabalhar com a visibilidade da coluna, você trabalhe também com a do campo no dataset.
Resposta: não ...o que é ligado ao PrtGrid é o DBgrid não o Dataset

procedure TForm1.Button1Click(Sender: TObject);

Var I : Integer;

begin

for I := 0 to CheckListBox1.Count - 1 do

begin

DBGrid1.Columns.Visible := CheckListBox1.Checked;

DBGrid1.Columns.Field.Visible := DBGrid1.Columns.Visible;

end;

end;

Resposta: da erro diz que esta fora da faixa quando seleciono no checklist.

Não tem como, ao invés de trabalhar com a Dbgrid trabalhar com a Query direto..ai acho que funcionaria....só não sei como fazer.

Pois a query manda pra dbgrid e ai ficaria tudo certo.

Tipo assim que eu tenho num programa:

QUERY1.fieldbyname('CONTATO').VISIBLE:=FALSE;

prtgrid1.PrintDialog;

QUERY1.fieldbyname('CONTATO').VISIBLE:=TRUE;

veja que ele fica o visible=false depois imprimi e volta a true fica beleza..

Só que não sei colocar pra que funciona na CheckListBox.

O que você acha??

muito Grato..t+

Editado por Eder
Link para o comentário
Compartilhar em outros sites
  • 0
Micheus

Micheus

Postado
Postado
Pois é, o tal do PrtGrid utiliza o DataSet ligado ao DBGrid, então para satisfazer suas necessidades (a dele) basta que além de trabalhar com a visibilidade da coluna, você trabalhe também com a do campo no dataset.
Resposta: não ...o que é ligado ao PrtGrid é o DBgrid não o Dataset
Eder, acho que você não entendeu o que eu escrevi. Eu disse "PrtGrid utiliza o DataSet ligado ao DBGrid" - acho que é diferente do que você entendeu.

Faça o que eu fiz. Voce tem o fonte do tal, então, abra ele e olhe lá na parte em que ele irá imprimir os registros e você verá que ele usa algo como FDBGrid.DataSet.Field[indice].IsVisible para saber se o campo está visível - no Dataset ligado ao DBGrid!!!

procedure TForm1.Button1Click(Sender: TObject);

Var I : Integer;

begin

for I := 0 to CheckListBox1.Count - 1 do

begin

DBGrid1.Columns[idx].Visible := CheckListBox1.Checked[idx];

DBGrid1.Columns[idx].Field.Visible := DBGrid1.Columns[idx].Visible;

end;

end;

Resposta: da erro diz que esta fora da faixa quando seleciono no checklist.

Fora da faixa é quando você tenta acessar um array com um índice que execede as posições possíveis.

Não estou entendendo este erro. Por acaso, você notou que além da nova linha foram adicionados um begin e um end? É que fica parecendo que a última linha (DBGrid1.Columns[idx].Field.Visible) poderia ter sido apenas acrescentada (sem o begin e end), o que resultaria em utilizar um valor de I diferente do esperado.

Não tem como, ao invés de trabalhar com a Dbgrid trabalhar com a Query direto..ai acho que funcionaria....só não sei como fazer.

Pois a query manda pra dbgrid e ai ficaria tudo certo.

Tipo assim que eu tenho num programa:

QUERY1.fieldbyname('CONTATO').VISIBLE:=FALSE;

prtgrid1.PrintDialog;

QUERY1.fieldbyname('CONTATO').VISIBLE:=TRUE;

veja que ele fica o visible=false depois imprimi e volta a true fica beleza..

poderia sim. A questão é que ainda acho que a forma anterior deveria funcionar - e ela é mais "simples", digamos assim.

Também não estou entendendo qual a finalidade de tratar a finalidade apenas no momento da impressão. Me parece que a impressão deveria refletir o que se está vendo na tela. Então, quando você esconde/mostra a coluna - esconde/mostra o campo do dataset.

de qualquer forma, como obter qual o nome do campo a tornar visível/invisível com relação a coluna do DBGrid?

Só lembro de um jeito: DBGrid.Columns[indice].FieldName.

Só que não sei colocar pra que funciona na CheckListBox.
QUERY1.fieldbyname(DBGrid.Columns[indice].FieldName).VISIBLE:=TRUE;

E neste caso, caímos novamente na situação da indexação de Columns...

Abraços

Link para o comentário
Compartilhar em outros sites
  • 0
Eder

Eder

Postado
  • Autor
Postado (editado)
Eder, acho que você não entendeu o que eu escrevi. Eu disse "PrtGrid utiliza o DataSet ligado ao DBGrid" - acho que é diferente do que você entendeu.
R.: Sim entendi errado mesmo..perdão.

Faça o que eu fiz. Voce tem o fonte do tal, então, abra ele e olhe lá na parte em que ele irá imprimir os registros e você verá que ele usa algo como FDBGrid.DataSet.Field[indice].IsVisible para saber se o campo está visível - no Dataset ligado ao DBGrid!!!

R.: Abri o fonte...mas na parte que imprimi não achei nada de estranho:

veja abaixo:

procedure TPrtGrid.PrintDialog;
begin
  with TPrintDialog.Create(Self) do begin
    try
      Options := [poPageNums, poPrintToFile, poWarning];
      MinPage := 1;
      MaxPage := MaxPages;
      FromPage := 1;
      ToPage := MaxPages;
      if Execute then begin
        if PrintRange = prPageNums then begin
          FFromPage := FromPage;
          FEndPage := EndPage;
        end;
        FOrientation:=GetOrientation;
        if PrintToFile then
          SaveToFile
        else begin
          FPrintToFile := false;
          Print;
        end;
      end;
    finally
      Free;
    end;
  end;
end;
Segue abaixo o *.pas do fonte do PrtGrid é eu não consegui fazer funcionar....de repente você olhando o fonte do PrtGrid...você me da uma luz... Valeu...muito Grato. t+ fonte: 
unit Prtgrid;

{ Original de Paul Rice }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DBGrids, DB, Printers, ExtCtrls, Grids;

const
  MaxPages = 1000;
  MaxCols = 100;

type
   TPageNumberPos = (pnNone,  pnTopLeft, pnTopCenter, pnTopRight,
                     pnBotLeft, pnBotCenter, pnBotRight);

   TPrtGrid = class(TComponent)
   private
      FFullPage: Boolean;
      OutFileName : TFileName;
      FDBGrid: TDBGrid;
      FTitleFont: TFont;
      FColHeaderFont: TFont;
      FColScale: integer;
      FLinesFont: TFont;
      FTitleAlign: TAlignment;
      FOrientation: TPrinterOrientation;
      FPageNLabel: String;
      FDateLabel: String;
      FPageNPos: TPageNumberPos;
      FDatePos: TPageNumberPos;
      FPrintFileName: String;
      FPrintFileDir: String;
      FTitle: String;
      FPrintMgrTitle: String;
      FirstRecordY: longint;
      DetailLineCharWidth: longint;
      DetailLineCharHeight: longint;
      RecCounter: longint;
      FPrintToFile: boolean;
      PrinterPageNo: longint;
      FFromPage: longint;
      FEndPage: longint;
      NPositions: integer;
      FTopMargin: integer;
      FBottomMargin: integer;
      FLeftMargin: integer;
      FRightMargin: integer;
      Positions: array[1..MaxCols]of longint;
      FColLines: boolean;
      FRowLines: boolean;
      FBorder: boolean;
      FHorizGap: integer;
      FVertGap: integer;
      procedure WriteAllToFile;
      procedure SetTitleFont(Value: TFont);
      procedure SetColHeaderFont(Value: TFont);
      procedure SetLinesFont(Value: TFont);
      procedure SetDBGrid(Value: TDBGrid);
      function GetDBGrid: TDBGrid;
      procedure SetPrintMgrTitle(const TmpStr: String);
      function GetPrintMgrTitle: String;
      function ColHeaderWidth(const ColHeaderStr: String): longint;
      function ColHeaderHeight: longint;
      procedure CalcPrinterPositions;
      function SetAlign(align:TAlignment; Left, Right: longint): longint;
      function SetPagePosX(PagePos: TPageNumberPos;
                           Left, Right: longint): longint;
      function SetPagePosY(PagePos: TPageNumberPos;
                           Top, Bottom: longint): longint;
      function PrepareAlign(Field: TField; Col: integer): longint;
      procedure WriteTitleToPrinter;
      procedure WriteColHdrsToPrinter(PosY: longint);
      procedure WriteRecordToPrinter;
      procedure PageJump;
      function RealWidth: longint;
      function AllPageFilled: boolean;
      procedure SetPixelsPerInch;
      function GetOrientation : TPrinterOrientation;
      procedure InitializePrinter;
   protected
      procedure SetName(const Value: TComponentName); override;
   public
      constructor Create(AOwner:TComponent); override;
      destructor Destroy; override;
      procedure Print;
      procedure PrintDialog;
      procedure SaveToFile;
   published
      property LeftMargin: integer read FLeftMargin write FLeftMargin;
      property TopMargin: integer read FTopMargin write FTopMargin;
      property RightMargin: integer read FRightMargin write FRightMargin;
      property BottomMargin: integer read FBottomMargin
                                     write FBottomMargin;
      property ColHeaderFont: TFont read FColHeaderFont
                                    write SetColHeaderFont;
      property ColScale: integer read FColScale write FColScale;  //*tj* added
      property TitleFont: TFont read FTitleFont write SetTitleFont;
      property LinesFont: TFont read FLinesFont write SetLinesFont;
      property DBGrid: TDBGrid read GetDBGrid write SetDBGrid;
      property PrintMgrTitle: String read GetPrintMgrTitle
                                     write SetPrintMgrTitle;
      property Title: String read FTitle write FTitle;
      property TitleAlignment: TAlignment read FTitleAlign
                                           write FTitleAlign;
      property Orientation: TPrinterOrientation read FOrientation
                                                write FOrientation;
      property PrintToFile: boolean read FPrintToFile write FPrintToFile;
      property FullPage: boolean read FFullPage write FFullPage;{RS 29.11.1996}
      property PrintFileName: String read FPrintFileName
                                     write FPrintFileName;
      property PrintFileDir: String read FPrintFileDir
                                     write FPrintFileDir;
      property FromPage: longint read FFromPage write FFromPage;
      property EndPage: longint read FEndPage write FEndPage;
      property Border: boolean read FBorder write FBorder;
      property ColLines: boolean read FColLines write FColLines;
      property RowLines: boolean read FRowLines write FRowLines;
      property HorizontalGap: integer read FHorizGap write FHorizGap;
      property VerticalGapPct: integer read FVertGap write FVertGap;
      property PageNumberPos: TPageNumberPos read FPageNPos
                                             write FPageNPos;
      property PageNumberLabel: String read FPageNLabel
                                       write FPageNLabel;
      property DatePos: TPageNumberPos read FDatePos write FDatePos;
      property DateLabel: String read FDateLabel write FDateLabel;
    end;

procedure Register;

implementation

var
  TextMetrics: TTextMetric;

function Max(a, b: longint): longint;
begin
  if a > b then Result := a else Result := b;
end;

function HeightScale(Value: longint; Pct: integer): longint;
begin
  if Pct > 100 then
    Pct := 100
  else
    if Pct < 0 then
      Pct := 0;
  if Pct = 0 then
    Result := Value
  else
    Result := Value + MulDiv(Value, Pct, 100);
end;

function CenterY(PosY, TextHt, Pct: longint): longint;
begin
  Result := PosY + (HeightScale(TextHt, Pct) - TextHt) div 2;
end;

constructor TPrtGrid.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FColHeaderFont := TFont.Create;
  FTitleFont := TFont.Create;
  FLinesFont := TFont.Create;
  FDBGrid := nil;
  FTitle := '';
  FPrintMgrTitle := '';
  RecCounter := 0;
  FHorizGap := 8;
  FVertGap := 40;
  FTopMargin := 60;
  FBottomMargin := 110;
  FLeftMargin := 30;
  FRightMargin := 30;
  FPrintToFile := False;
  FPrintFileName := 'GRID.LST';
  FPrintFileDir := 'C:\';
  FFullPage := false;
  FFromPage := 1;
  FEndPage := MaxPages;
  FBorder := False;
  FColLines := True;
  FRowLines := False;
  FTitleAlign := taCenter;
  FPageNPos := pnBotCenter;
  FPageNLabel := 'Page: ';
  FDatePos := pnTopRight;
  FDateLabel := '';
  FOrientation := poLandscape;
  FTitleFont.Name := 'Arial';
  FTitleFont.Style := [fsBold];
  FTitleFont.Size := 12;
  FColHeaderFont.Name := 'Arial';
  FColHeaderFont.Style := [fsBold];
  FColHeaderFont.Size := 10;
  FColScale := 100;
  FLinesFont.Name := 'Arial';
  FLinesFont.Style := [];
  FLinesFont.Size := 9;
end;

destructor TPrtGrid.Destroy;
begin
  FColHeaderFont.Free;
  FTitleFont.Free;
  FLinesFont.Free;
  inherited Destroy;
end;

procedure TPrtGrid.SetColHeaderFont(Value: TFont);
begin
  FColHeaderFont.Assign(Value);
end;

procedure TPrtGrid.SetTitleFont(Value: TFont);
begin
  FTitleFont.Assign(Value);
end;

procedure TPrtGrid.SetLinesFont(Value: TFont);
begin
  FLinesFont.Assign(Value);
end;

procedure TPrtGrid.SetDBGrid(Value: TDBGrid);
begin
  FDBGrid := Value;
end;

function TPrtGrid.GetDBGrid: TDBGrid;
begin
  Result := FDBGrid;
end;

procedure TPrtGrid.SetPrintMgrTitle(const TmpStr: String);
begin
  FPrintMgrTitle := TmpStr;
end;

function TPrtGrid.GetPrintMgrTitle: String;
begin
  Result := FPrintMgrTitle;
end;

procedure TPrtGrid.SetName(const Value: TComponentName);
var
  ChangeText: Boolean;
begin
  ChangeText := (Name = FPrintMgrTitle) and ((Owner = nil)
      or not (Owner is TPrtGrid)
      or not (csLoading in TPrtGrid(Owner).ComponentState));
  inherited SetName(Value);
  if ChangeText then
    FPrintMgrTitle := Value;
end;

procedure TPrtGrid.WriteAllToFile;
var
  OutFile: TextFile;
  BookMark1: TBookMark;
  FieldNo: longint;
  TmpStr: String;
begin
  if OutFileName = '' then
    if FPrintFileName = '' then
      OutFileName := 'C:\GRID.LST'
    else
      OutFileName := FPrintFileDir+FPrintFileName;
   {$I-}
   AssignFile(OutFile, OutFileName);
   Rewrite(OutFile);
   {$I+}
   if IOResult <> 0 then begin
     ShowMessage('Erro para abrir o arquivo :' + OutFileName);
     Exit;
   end;

   with FDBGrid.DataSource.DataSet do begin
     Writeln(OutFile, FTitle+' - Importa para o Excel (Delimitado por Tab)');
     TmpStr := '';
      for FieldNo := 0 to FieldCount - 1 do
         if Fields[FieldNo].Visible then
            TmpStr := TmpStr + Fields[FieldNo].DisplayLabel + #9;
      WriteLn(OutFile, TmpStr);
      Screen.Cursor := crHourGlass;
      Bookmark1 := GetBookMark;
      try
        DisableControls;
        RecCounter := 0;
        First;
        while not EOF do begin
          TmpStr := '';
          for FieldNo := 0 to FieldCount - 1 do
            if Fields[FieldNo].Visible then
              TmpStr := TmpStr + Fields[FieldNo].DisplayText + #9;
          WriteLn(OutFile, TmpStr);
          Inc(RecCounter);
          Next;
        end;
      finally
        Screen.Cursor := crDefault;
        EnableControls;
        CloseFile(OutFile);
        GotoBookMark(BookMark1);
        FreeBookMark(BookMark1);
     end;
   end;
end;

function TPrtGrid.ColHeaderWidth(const ColHeaderStr: String): longint;
var
  tmpFont: TFont;
begin
  with Printer.Canvas do begin
    tmpFont := TFont.Create;
    tmpFont.Assign(Font);
    Font.Assign(FColHeaderFont);
    SetPixelsPerInch;
    Result := TextWidth(ColHeaderStr);
    Font.Assign(tmpFont);
    tmpFont.Free;
    SetPixelsPerInch;
  end;
end;

function TPrtGrid.ColHeaderHeight: longint;
var
  tmpFont: TFont;
begin
  with Printer.Canvas do begin
    tmpFont := TFont.Create;
    tmpFont.Assign(Font);
    Font.Assign(FColHeaderFont);
    SetPixelsPerInch;
    Result := HeightScale(TextHeight('M'), FVertGap);
    Font.Assign(tmpFont);
    SetPixelsPerInch;
    tmpFont.Free;
  end;
end;

procedure TPrtGrid.CalcPrinterPositions;
var
  ColWidth, FieldNo: longint;
begin
  if FBorder then
    Positions[1] := 1
  else
    Positions[1] := 0;

  NPositions := 0;
  with FDBGrid.DataSource.DataSet do
    for FieldNo := 0 to FieldCount - 1 do
      if Fields[FieldNo].Visible then begin
        inc(NPositions);
        ColWidth := Max(ColHeaderWidth(Fields[FieldNo].DisplayLabel),
                  (DetailLineCharWidth * Fields[FieldNo].DisplayWidth));
        Positions[NPositions + 1] := Positions[NPositions]
                  + ColWidth + 2*FHorizGap;
      end;
end;

function TPrtGrid.SetAlign(align: TAlignment; Left, Right:longint):longint;
var
  PosX: longint;
begin
  PosX := 0;
  with Printer.Canvas do begin
    case Align of
       taLeftJustify:
          begin
             SetTextAlign(Handle, TA_LEFT);
             PosX := Left + FHorizGap;
          end;
       taRightJustify:
          begin
             SetTextAlign(Handle, TA_RIGHT);
             PosX := Right - FHorizGap;
          end;
       taCenter:
          begin
             SetTextAlign(Handle, TA_CENTER);
             PosX := Left + Round((Right - Left) / 2);
          end;
      end;
   end;
   Result := PosX;
end;

function TPrtGrid.SetPagePosX(PagePos: TPageNumberPos; Left, Right: longint): longint;
var
   PosX: longint;
begin
   PosX := 0;
   with Printer.Canvas do begin
     case PagePos of
        pnTopLeft, pnBotLeft:
           begin
              SetTextAlign(Handle, TA_LEFT);
              PosX := Left + FHorizGap;
           end;
        pnTopRight, pnBotRight:
           begin
              SetTextAlign(Handle, TA_RIGHT);
              PosX := Right - FHorizGap;
           end;
        pnTopCenter, pnBotCenter:
           begin
              SetTextAlign(Handle, TA_CENTER);
              PosX := Left + Round((Right - Left)/2);
           end;
     end;
  end;
  Result := PosX;
end;

function TPrtGrid.SetPagePosY(PagePos: TPageNumberPos; Top, Bottom: longint): longint;
var
   PosY: longint;
begin
   case PagePos of
      pnBotLeft, pnBotCenter, pnBotRight:
         begin
            PosY := Bottom;
         end;
   else
      PosY := Top;
   end;
   Result := PosY;
end;

function TPrtGrid.PrepareAlign(Field:TField; Col:integer): longint;
begin
   Result := SetAlign(Field.Alignment, Positions[col], Positions[col + 1]);
end;

procedure TPrtGrid.WriteTitleToPrinter;
var
  PosX, PosY, FieldNo, tmpColHeaderHeight: longint;
  TmpFont: TFont;
  tmpFontCreated: boolean;
begin
  if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then
    with Printer.Canvas do begin
      tmpColHeaderHeight := ColHeaderHeight;
      tmpFont := TFont.Create;
      if (FTitle <> '') or (FDatePos <> pnNone) or (FPageNPos <> pnNone) then begin
        tmpFont.Assign(Font);
        Font.Assign(FTitleFont);
        SetPixelsPerInch;
        tmpFontCreated := True;
      end
      else
        tmpFontCreated := False;

      if FDatePos <> pnNone then begin
        if FDateLabel = '' then
           FDateLabel := FormatDateTime('mmm d, yyyy',SysUtils.Date);
        PosX := SetPagePosX(FDatePos, FLeftMargin, FLeftMargin + RealWidth);
        PosY := SetPagePosY(FDatePos, FTopMargin, Printer.PageHeight - FBottomMargin);
        TextOut(PosX, PosY, FDateLabel);
      end;

      if FTitle <> '' then begin
        PosX := SetAlign(FTitleAlign, FLeftMargin, FLeftMargin + RealWidth);
        TextOut(PosX, FTopMargin, FTitle);
      end;

      if FPageNPos <> pnNone then begin
        PosX := SetPagePosX(FPageNPos, FLeftMargin, FLeftMargin + RealWidth);
        PosY := SetPagePosY(FPageNPos, FTopMargin, Printer.PageHeight - FBottomMargin + 8);
        TextOut(PosX, PosY, FPageNLabel + IntToStr(PrinterPageNo));
      end;

      if (FTitle <> '') or (FDatePos in [pnTopLeft, pnTopCenter, pnTopRight])
         or (FPageNPos in [pnTopLeft, pnTopCenter, pnTopRight]) then
        FirstRecordY := FTopMargin + HeightScale(TextHeight('M'), FVertGap) + tmpColHeaderHeight
      else
        FirstRecordY := FTopMargin + tmpColHeaderHeight;

      if tmpFontCreated then begin
        Font.Assign(tmpFont);
        SetPixelsPerInch;
      end;
      tmpFont.Free;

      if FFullPage then
        if FColLines then
           for FieldNo := 2 to NPositions do begin
              MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
              LineTo(FLeftMargin + Positions[FieldNo], Printer.PageHeight - FBottomMargin);
           end;

      if dgTitles in FDBGrid.Options then
         WriteColHdrsToPrinter(FirstRecordY - tmpColHeaderHeight);
   end;
end;

procedure TPrtGrid.WriteColHdrsToPrinter(PosY: longint);
var
  Col, PosX:  longint;
  DSrcFld: longint;
  TmpFont: TFont;
  Rect: TRect;
begin
  with FDBGrid.DataSource.DataSet, Printer.Canvas do begin
    tmpFont := TFont.Create;
    tmpFont.Assign(Font);
    Font.Assign(FColHeaderFont);
    SetPixelsPerInch;
    Rect.top := CenterY(PosY, TextHeight('M'), 2*FVertGap);
    Rect.bottom := FirstRecordY+((RecCounter + 1) * TextHeight('M'));
    Col := 0;
    for DSrcFld := 0 to FieldCount - 1 do begin
      if Fields[DSrcFld].Visible then begin
        inc(Col);
        PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
        Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
        Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
        TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayLabel);
      end;
    end;
    Moveto(FLeftMargin, FirstRecordY);
    Lineto(FLeftMargin + RealWidth, FirstRecordY);
    Font.Assign(tmpFont);
    SetPixelsPerInch;
    tmpFont.Free;
   end;
end;

procedure TPrtGrid.WriteRecordToPrinter;
var
  Col, PosX, PosY, FieldNo: longint;
  DSrcFld: longint;
  tmpFont: TFont;
  Rect: TRect;
begin
  if (PrinterPageNo >= FFromPage) and (PrinterPageNo <= FEndPage) then
    with FDBGrid.DataSource.DataSet, Printer.Canvas do begin
      tmpFont := TFont.Create;
      tmpFont.Assign(Font);
      Font.Assign(FLinesFont);
      SetPixelsPerInch;
      Col := 0;
      PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
      Rect.top := CenterY(PosY, TextHeight('M'), FVertGap);
      Rect.bottom:=FirstRecordY+((RecCounter+1) * DetailLineCharHeight);
      for DSrcFld := 0 to FieldCount - 1 do begin
         if Fields[DSrcFld].Visible then begin
            inc(Col);
            PosX := FLeftMargin + PrepareAlign(Fields[DSrcFld], Col);
            Rect.left := FLeftMargin + Positions[Col] + FHorizGap;
            Rect.right := FLeftMargin + Positions[Col+1] - FHorizGap;
            TextRect(Rect, PosX, Rect.top, Fields[DSrcFld].DisplayText);
         end;
      end;

      if FRowLines then begin
        MoveTo(FLeftMargin, PosY);
        LineTo(FLeftMargin + RealWidth, PosY);
      end;

      if not FFullPage then
        if FColLines then
          for FieldNo := 2 to NPositions do begin
            MoveTo(FLeftMargin + Positions[FieldNo], FirstRecordY);
            LineTo(FLeftMargin + Positions[FieldNo], PosY + DetailLineCharHeight);
          end;

      Font.Assign(tmpFont);
      SetPixelsPerInch;
      tmpFont.Free;
    end;
end;

procedure TPrtGrid.PageJump;
begin
  RecCounter := 0;
  if (PrinterPageNo >= FFromPage) and (PrinterPageNo < FEndPage) then
    Printer.NewPage;
  inc(PrinterPageNo);
end;

function TPrtGrid.RealWidth: longint;
begin
  Result := Printer.PageWidth - FLeftMargin - FRightMargin;
end;

function TPrtGrid.AllPageFilled: boolean;
begin
  Result := (not FPrintToFile)
      and ((FirstRecordY + (RecCounter + 1) * DetailLineCharHeight)
            >= (Printer.PageHeight - FBottomMargin));
end;

procedure TPrtGrid.Print;
var
  BMark: TBookMark;
  PosY: longint;
  tmpStyle: TBrushStyle;
begin
  PosY := 0;
  if not Assigned(FDBGrid) then
    raise Exception.Create('Erro: DBGrid não associado.');
  if FPrintToFile then begin
    WriteAllToFile;
    Exit;
  end;
  InitializePrinter;
  with FDBGrid.DataSource.DataSet do begin
    BMark := GetBookMark;
    try
      DisableControls;
      RecCounter := 0;
      PrinterPageNo := 1;
      CalcPrinterPositions;
      if (Positions[NPositions + 1] > RealWidth) then
      begin
        if MessageDlg('Impressão muito larga para o papel.'+
           ' Aborta a impressão?', mtConfirmation, mbYesNoCancel, 0 )<>idNo then
        begin
          Printer.Abort;
          exit;
        end;
      end;
      Screen.Cursor := crHourGlass;
      First;
      while not EOF do begin
        if RecCounter = 0 then
           WriteTitleToPrinter;
        WriteRecordToPrinter;
        Inc(RecCounter);
        Next;
        if AllPageFilled then begin
          PageJump;
          if PrinterPageNo > FEndPage then break;
        end;
      end;
      if FRowLines then begin
        PosY := FirstRecordY + RecCounter * DetailLineCharHeight;
        Printer.Canvas.MoveTo(FLeftMargin, PosY);
        Printer.Canvas.LineTo(FLeftMargin + RealWidth, PosY);
      end;
      if FBorder then begin
        tmpStyle:=Printer.Canvas.Brush.Style;
        Printer.Canvas.Brush.Style:=bsClear;
        if FullPage then
          Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - ColHeaderHeight,
              FLeftMargin + RealWidth, Printer.PageHeight - FBottomMargin)
        else
          Printer.Canvas.Rectangle(FLeftMargin, FirstRecordY - ColHeaderHeight,
              FLeftMargin + RealWidth, PosY);
          Printer.Canvas.Brush.Style:=tmpStyle;
      end;
    finally
      EnableControls;
      Screen.Cursor := crDefault;
      GotoBookMark(BMark);
      FreeBookMark(BMark);
      Printer.EndDoc;
    end;
  end;
end;

procedure TPrtGrid.PrintDialog;
begin
  with TPrintDialog.Create(Self) do begin
    try
      Options := [poPageNums, poPrintToFile, poWarning];
      MinPage := 1;
      MaxPage := MaxPages;
      FromPage := 1;
      ToPage := MaxPages;
      if Execute then begin
        if PrintRange = prPageNums then begin
          FFromPage := FromPage;
          FEndPage := EndPage;
        end;
        FOrientation:=GetOrientation;
        if PrintToFile then
          SaveToFile
        else begin
          FPrintToFile := false;
          Print;
        end;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TPrtGrid.SaveToFile;
begin
  FPrintToFile := true;
  with TSaveDialog.Create(Self) do begin
    try
      Filter := 'List Files (*.LST)|*.LST|Any file(*.*)|*.*';
      if FPrintFileDir <> '' then InitialDir := FPrintFileDir;
      if FPrintFileName <> '' then begin
        FileName := FPrintFileName;
        Filter := Filter + '|This file (*' + ExtractFileExt(FileName) + ')|*'
            + ExtractFileExt(FileName);
        FilterIndex := 3;
      end;
      if Execute then begin
        FPrintFileDir := ExtractFilePath(FileName);
        FPrintFileName := ExtractFileName(FileName);
        OutFileName := FileName;
        Print;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TPrtGrid.SetPixelsPerInch;
var
  FontSize: integer;
begin
  if not Printer.Printing then
    ShowMessage('Erro: BeginDoc não foi chamado antes do SetPixelsPerInch');
  FontSize:=Printer.Canvas.Font.Size;
  Printer.Canvas.Font.PixelsPerInch:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
  Printer.Canvas.Font.Size := FontSize;
  GetTextMetrics( Printer.Canvas.Handle,TextMetrics );
end;

function TPrtGrid.GetOrientation : TPrinterOrientation;
var
  FDevice, FDriver, FPort: PChar;
  FHandle: THandle;
  FDeviceMode: PDevMode;
begin
  result := poPortrait;
  GetMem (FDevice, 255);
  GetMem (FDriver, 255);
  GetMem (FPort, 255);
  Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
  if FHandle = 0 then begin
    Printer.PrinterIndex := Printer.PrinterIndex;
    Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
  end;
  if FHandle <> 0 then begin
    FDeviceMode := Ptr(FHandle);
    case FDeviceMode^.dmOrientation of
       dmOrient_Portrait:   result := poPortrait;
       dmOrient_Landscape:  result := poLandscape;
    else
       result := poLandscape;
    end;
  end
  else
     ShowMessage('Erro não consigo identificar o modo de saida');
  FreeMem (FDevice, 255);
  FreeMem (FDriver, 255);
  FreeMem (FPort, 255);
end;

procedure TPrtGrid.InitializePrinter;
begin
  Printer.Orientation := FOrientation;
  Printer.BeginDoc;
  Printer.Title := FPrintMgrTitle;
  Printer.Canvas.Font.Assign(FLinesFont);
  SetPixelsPerInch;
  FVertGap:= Trunc(TextMetrics.tmHeight * 0.8);
  FHorizGap:= TextMetrics.tmMaxCharWidth div 4;
  DetailLineCharHeight := HeightScale(TextMetrics.tmHeight,FVertGap);
  DetailLineCharWidth := TextMetrics.tmMaxCharWidth;
  if (FColScale <> 100) and (FColScale > 0) and (FColScale < 500) then
    DetailLineCharWidth := 1+Trunc(DetailLineCharWidth * ColScale / 100);
end;

procedure Register;
begin
  RegisterComponents('Data Controls', [TPrtGrid]);
end;

end.

Editado por Micheus
Substituido as tag's [quote] por [code] para melhorar visualização do código fonte
Link para o comentário
Compartilhar em outros sites
  • 0
Micheus

Micheus

Postado
Postado
R.: Abri o fonte...mas na parte que imprimi não achei nada de estranho
Mas não tem nada de estranho com o código não. Eu disse que ele utiliza a propriedade Visible do campo na lista de campos do dataset ligado ao seu DBGrid - só isso.

Faça uma busca no código (localizar) procurando pelo texto Fields, e você verá que ele aparecerá em vários pontos no processo de impressão e tem como origem RDBGrid.DataSource.DataSet. Voce vai achar sempre antes dele a linha "with FDBGrid.DataSource.DataSet do begin".

Daí você comprova o que eu disse e o que você já havia comprovado na prática: a visibilidade da coluna é ignorada, ela vem do DataSet.

Por isso que eu disse que as colunas que você não quer que sejam impressas devem ser tornadas visíeis e invisíveis não apenas utilizando a propriedade Columns do DBGrid (esse seria apenas visual na tela), mas também, os campos (Fields) na lista de campos do seu dataset (esse seria apenas utilizado no relatório). Será que agora você entendeu. Foi a modificação que sugeri no código - inclusão do DBGrid.Columns[indice].Field.Visible ou como você mesmo sugeriu dataset.fieldbyname().Visible.

Link para o comentário
Compartilhar em outros sites
  • 0
Eder

Eder

Postado
  • Autor
Postado
Faça uma busca no código (localizar) procurando pelo texto Fields, e você verá que ele aparecerá em vários pontos no processo de impressão e tem como origem RDBGrid.DataSource.DataSet. Voce vai achar sempre antes dele a linha "with FDBGrid.DataSource.DataSet do begin".

Daí você comprova o que eu disse e o que você já havia comprovado na prática: a visibilidade da coluna é ignorada, ela vem do DataSet.

R. Ok...Verifiquei e você tem razão...

Por isso que eu disse que as colunas que você não quer que sejam impressas devem ser tornadas visíeis e invisíveis não apenas utilizando a propriedade Columns do DBGrid (esse seria apenas visual na tela), mas também, os campos (Fields) na lista de campos do seu dataset (esse seria apenas utilizado no relatório). Será que agora você entendeu. Foi a modificação que sugeri no código - inclusão do DBGrid.Columns[indice].Field.Visible ou como você mesmo sugeriu dataset.fieldbyname().Visible.

R. Micheus.....ai é que ta.....pois eu sei que tenho que escolher atraves do checklist os campos visiveis as quais quero imprimir...e atraves desta seleção eu sei que também tenho que tornar visiveis os campos do dataset também.......pois é atraves do dataset que ele vai me dizer quais campos vou imprimir e ai usar o PrtGrid.....resumindo o dbgrid e o dataset devem interagir juntos....atraves da escolha do checklist.

Ok...entendi mais não sei bolar o codigo....por favor me ajuda.

Valor supor que tenho 5 campos na tabela e coloquei estes 5 campo no checklist pro usuario escolher qual quer visualizar e consequentemente imprimir...

O que fazer agora??

muito Grato....pela paciências.

t+

Link para o comentário
Compartilhar em outros sites
  • 0
Micheus

Micheus

Postado
Postado
Ok...entendi mais não sei bolar o codigo....por favor me ajuda.

Valor supor que tenho 5 campos na tabela e coloquei estes 5 campo no checklist pro usuario escolher qual quer visualizar e consequentemente imprimir...

O que fazer agora??

Eder, aquele código lá do post #7 (logo abaixo) não resolveu pelo que você informou:

procedure TForm1.Button1Click(Sender: TObject);
Var I : Integer;
begin
  for I := 0 to CheckListBox1.Count - 1 do
  begin
    DBGrid1.Columns[idx].Visible := CheckListBox1.Checked[idx];
    DBGrid1.Columns[idx].Field.Visible := DBGrid1.Columns[idx].Visible;
  end;
end;

mas ele deveria funcionar.

Você não deu retorno quanto ao meu questionamento no post #9:

Fora da faixa é quando você tenta acessar um array com um índice que execede as posições possíveis.

Não estou entendendo este erro. Por acaso, você notou que além da nova linha foram adicionados um begin e um end? É que fica parecendo que a última linha (DBGrid1.Columns[idx].Field.Visible) poderia ter sido apenas acrescentada (sem o begin e end), o que resultaria em utilizar um valor de I diferente do esperado.

Link para o comentário
Compartilhar em outros sites
  • 0
Eder

Eder

Postado
  • Autor
Postado
procedure TForm1.Button1Click(Sender: TObject);

Var I : Integer;

begin

for I := 0 to CheckListBox1.items.Count - 1 do

begin

DBGrid1.Columns[idx].Visible := CheckListBox1.Checked[idx];

DBGrid1.Columns[idx].Field.Visible := DBGrid1.Columns[idx].Visible;

end;

end;

Resposta: O que seria este [idx] e como colocar no meu exemplo??

porque se eu coloco tipo assim: [1] ele da aquele erro:

Lista de indices fora da faixa nr 1

acho que é aqui que não tou sabendo interpretar!!!

:(

Link para o comentário
Compartilhar em outros sites
  • 0
Eder

Eder

Postado
  • Autor
Postado
foi mal, mas dava para sacar... não é Idx, tinha que ser o seu "I" - o do for
R. Beleza sem problemas.

:D

Mas carinha..coloquei assim mas mesmo assim aparece este erro:

LISTA DE INDICES FORA DA FAIXA 4este nr muda conforma a marcação no checklistbox

procedure TForm1.EncartaButton1Click(Sender: TObject);

Var I : Integer;

begin

for I := 0 to CheckListBox1.items.Count - 1 do

begin

DBGrid1.Columns.Visible := CheckListBox1.Checked;

DBGrid1.Columns.Field.Visible := DBGrid1.Columns.Visible;

end;

end;

Valeu :D

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...