Selecting a cell in TStringGrid

• Previous message: pr: "Re: Can't access to numerial fields using adoquery ..."
• Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]

Date: 30 May 2004 23:57:39 -0700

Hi!
Here follows a training case I'm doing in order to learn myself
programming. Please feel free to contribute. The full project will be
emailed if interest.

I use a TStringGrid and TCalendar for simulating a scheduler. It works
very nice. However, I want to be able to let the user delete entries,
say 08:30 or 10:00, by clicking the selected cell. I do this in the
procedure TfrmAvt.grAvtSelectCell(Sender: TObject; ACol, ARow:
Integer;
  var CanSelect: Boolean);
begin
if (ARow = 1) then
 if MessageDlg('You really want to delete ' + ARow + '?',
mtConfirmation,[mbYes,mbNo],0) = mrYes then
begin
   ...and so on...
 end;
end;

However, in order to identify the text in cell[0,1], cell[0,2] and so
on, and give it in the message dialog, I need to get the text for each
rowclick. How can I combine the text for each fixed row with my
message dialog and delete the text in row (column 1, not the fixed
column)? Should I use an array to cycle through the text in each row
of column 1 or...

Anyway, this scheduler is a training case. Source code follows:
{FILESAVE AND FILELOAD ROUTINES}
procedure TfrmAvt.LoadGrid(strGrid:TStringGrid;const FileName:String);
var
f:TextFile;
i,j,k:Integer;
strTemp:String;
begin
Screen.Cursor := crHourGlass;
try
if not FileExists(FileName) then
try
AssignFile(f,FileName);
 try
  Reset(f);
  try
   with grAvt do
   begin
        ReadLn(f,k);
        ColCount := k;
        ReadLn(f,k);
        RowCount := k;
        for i := 0 to ColCount do
        for j := 0 to RowCount do
        begin
        ReadLn(f,strTemp);
        Cells[i,j] := strTemp;
        end;
       end;
        except
        on E:EInOutError do ShowMessage(E.Message);
       end;
      except
     on E:EInOutError do showMessage(E.Message);
    end;
   except
  on E:EInOutError do showMessage(E.Message);
end
else if FileExists(FileName) then
        try
         AssignFile(f,FileName);
         try
          Reset(f);
           try
                with grAvt do
                begin
                ReadLn(f,k);
                ColCount := k;
                ReadLn(f,k);
                RowCount := k;
                for i := 0 to ColCount do
                for j := 0 to RowCount do
                begin
                ReadLn(f,strTemp);
                Cells[i,j] := strTemp;
              end;
              end;
              except
             on E:EInOutError do ShowMessage(E.Message);
            end;
           except
          on E:EInOutError do ShowMessage(E.Message);
         end;
       except
      on E:EInOutError do ShowMessage(E.Message);
     end;
    finally
   CloseFile(f);
  end;
 Screen.Cursor := crDefault;
end;
procedure TfrmAvt.SaveGrid(strGrid:TStringGrid;const FileName:String);
var
f:TextFile;
i,j:Integer;
begin
Screen.Cursor := crHourGlass;
try
 if not FileExists(FileName) then
  try
   AssignFile(f,FileName);
    try
     Rewrite(f);
      try
       with grAvt do
        begin
         Writeln(f,ColCount);
          Writeln(f,RowCount);
           for i := 0 to ColCount do
            for j := 0 to RowCount do
             begin
              Writeln(f,Cells[i,j]);
              end;
              end;
              except
             on E:EInOutError do ShowMessage(E.Message);
             end;
             except
             on E:EInOutError do showMessage(E.Message);
             end;
             except
             on E:EInOutError do showMessage(E.Message);
            end
            else if FileExists(FileName) then
            try
            AssignFile(f,FileName);
            try
            Rewrite(f);
            try
            with grAvt do
            begin
            Writeln(f,ColCount);
            Writeln(f,RowCount);
            for i := 0 to ColCount do
            for j := 0 to RowCount do
            begin
            Writeln(f,Cells[i,j]);
            end;
            end;
            except
            on E:EInOutError do ShowMessage(E.Message);
           end;
          except
         on E:EInOutError do ShowMessage(E.Message);
         end;
        except
       on E:EInOutError do ShowMessage(E.Message);
      end;
    finally
   CloseFile(f);
  end;
 Screen.Cursor := crDefault;
end;
{SKJEMA SKAPES}
procedure TfrmAvt.FormCreate(Sender: TObject);
var
f,g : string;
begin
Caption := Application.Title + ' ['+FormatDateTime('dd. mmm
yyyy',now)+']';
g := 'C:\BUGS\DATA\';
calAvt.Date := now;
if not DirectoryExists(g) then
try
ForceDirectories(g);
except
on E:EInOutError do
ShowMessage(E.Message);
end;
Width := 640;
Height := 495;
calAvt.Left := 5;
calAvt.Top := 26;
calAvt.Width := 265;
calAvt.Height := 191;
grAvt.Left := 272;
grAvt.Top := 2;
grAvt.Width := 353;
grAvt.Height := 423;
Image1.Left := 5;
Image1.Top := 224;
Image1.Width := 257;
Image1.Height := 209;
stbAvt.Top := 434;
stbAvt.Left := 0;
stbAvt.Width := 632;
stbAvt.Height := 19;
btnToday.Enabled := false;
btnToday.Hint := '';
f := 'C:\BUGS\DATA\' + FormatDateTime('dmyyyy',calAvt.Date) + '.txt';
if not FileExists(f) then
begin
btnSpara.Enabled := false;
btnDelete.Enabled := false;
grAvt.FixedColor := clBtnFace;
stbAvt.Panels[1].Text := 'VENTER...';
stbAvt.Panels[2].Text := 'OK';
stbAvt.Panels[3].Text := 'Åpen kl: ' + TimeToStr(Time);
with grAvt do
begin
EditorMode := false;
ColCount := 2;
RowCount := 17;
DefaultRowHeight := 23;
DefaultColWidth := 44;
ColWidths[1] := 280;
RowHeights[1] := 22;
RowHeights[2] := 22;
RowHeights[3] := 22;
RowHeights[4] := 22;
RowHeights[5] := 22;
RowHeights[6] := 22;
RowHeights[7] := 22;
RowHeights[8] := 22;
RowHeights[9] := 22;
RowHeights[10] := 22;
RowHeights[11] := 22;
RowHeights[12] := 22;
RowHeights[13] := 22;
RowHeights[14] := 22;
RowHeights[15] := 22;
RowHeights[16] := 22;
Cells[1,0] := 'NAVN '+ ' [' +
FormatDateTime('dd.mmm yyyy',calAvt.Date) + ']';
Cells[0,1] := '08:00';
Cells[0,2] := '08:30';
Cells[0,3] := '09:00';
Cells[0,4] := '09:30';
Cells[0,5] := '10:00';
Cells[0,6] := '10:30';
Cells[0,7] := '11:00';
Cells[0,8] := '11:30';
Cells[0,9] := '12:00';
Cells[0,10] := '12:30';
Cells[0,11] := '13:00';
Cells[0,12] := '13:30';
Cells[0,13] := '14:00';
Cells[0,14] := '14:30';
Cells[0,15] := '15:00';
Cells[0,16] := '15:30';
end;
end
else if FileExists(f) then
begin
LoadGrid(grAvt,f);
grAvt.EditorMode := false;
btnSpara.Enabled := false;
btnDelete.Enabled := true;
grAvt.FixedColor := clBtnFace;
stbAvt.Panels[1].Text := 'SKAPT';
stbAvt.Panels[2].Text := 'OK';
stbAvt.Panels[3].Text := 'Åpnes kl: ' + TimeToStr(Time);
with grAvt do
begin
ColWidths[1] := 280;
RowHeights[1] := 22;
RowHeights[2] := 22;
RowHeights[3] := 22;
RowHeights[4] := 22;
RowHeights[5] := 22;
RowHeights[6] := 22;
RowHeights[7] := 22;
RowHeights[8] := 22;
RowHeights[9] := 22;
RowHeights[10] := 22;
RowHeights[11] := 22;
RowHeights[12] := 22;
RowHeights[13] := 22;
RowHeights[14] := 22;
RowHeights[15] := 22;
RowHeights[16] := 22;
Cells[1,0] := 'NAVN '+ ' [' +
FormatDateTime('dd.mmm yyyy',calAvt.Date) + ']';
end;
end;
end;
{SKJEMAVISNING}
procedure TfrmAvt.FormShow(Sender: TObject);
var
w,h: integer;
begin
w := Screen.Width;
h := Screen.Height;
stbAvt.Panels[1].Text := 'Skjerm: ' + IntToStr(w) + 'x' + IntToStr(h);
end;
{GÅ TIL IDAG-KNAPPEN}
procedure TfrmAvt.btnTodayClick(Sender: TObject);
var
w,h : integer;
begin
calAvt.Date := now;
grAvt.Cells[1,0] := 'NAVN '+ ' [' +
FormatDateTime('dd.mmm yyyy',calAvt.Date) + ']';
btnSpara.Enabled := false;
btnToday.Enabled := false;
btnToday.Hint := '';
w := Screen.Width;
h := Screen.Height;
stbAvt.Panels[1].Text := 'Skjerm: ' + IntToStr(w) + 'x' + IntToStr(h);
end;
{KALENDER ENDRER DATO}
procedure TfrmAvt.calAvtChange(Sender: TObject);
var
f : string;
i,j : integer;
begin
f := 'C:\BUGS\DATA\' + FormatDateTime('dmyyyy',calAvt.Date) + '.txt';
stbAvt.Panels[1].Text := Application.Title +
'[' + FormatDateTime('mmm - yyyy',calAvt.Date)+ ']';
if not FileExists(f) then
begin
for i := 0 to grAvt.ColCount do
 for j := 0 to grAvt.RowCount do
 begin
  grAvt.Cells[i,j] := '';
  end;
with grAvt do
begin
FixedColor := clBtnFace;
EditorMode := false;
ColWidths[1] := 280;
RowHeights[1] := 22;
RowHeights[2] := 22;
RowHeights[3] := 22;
RowHeights[4] := 22;
RowHeights[5] := 22;
RowHeights[6] := 22;
RowHeights[7] := 22;
RowHeights[8] := 22;
RowHeights[9] := 22;
RowHeights[10] := 22;
RowHeights[11] := 22;
RowHeights[12] := 22;
RowHeights[13] := 22;
RowHeights[14] := 22;
RowHeights[15] := 22;
RowHeights[16] := 22;
Cells[1,0] := 'NAVN '+ ' [' +
FormatDateTime('dd.mmm yyyy',calAvt.Date) + ']';
Cells[0,1] := '08:00';
Cells[0,2] := '08:30';
Cells[0,3] := '09:00';
Cells[0,4] := '09:30';
Cells[0,5] := '10:00';
Cells[0,6] := '10:30';
Cells[0,7] := '11:00';
Cells[0,8] := '11:30';
Cells[0,9] := '12:00';
Cells[0,10] := '12:30';
Cells[0,11] := '13:00';
Cells[0,12] := '13:30';
Cells[0,13] := '14:00';
Cells[0,14] := '14:30';
Cells[0,15] := '15:00';
Cells[0,16] := '15:30';
if (calAvt.Date <> now) then btnToday.Enabled := true;
btnToday.Hint := 'GÅ TIL IDAG!';
btnSpara.Enabled := false;
btnDelete.Enabled := false;
stbAvt.Panels[1].Text := TimeToStr(Time);
stbAvt.Panels[2].Text := 'OK';
stbAvt.Panels[3].Text := 'Ingen fil! ' + TimeToStr(Time);
grAvt.FixedColor := clBtnFace;
end;
end
else if FileExists(f) then
with grAvt do begin
LoadGrid(grAvt,f);
EditorMode := false;
FixedColor := clBtnFace;
ColWidths[1] := 280;
RowHeights[1] := 22;
RowHeights[2] := 22;
RowHeights[3] := 22;
RowHeights[4] := 22;
RowHeights[5] := 22;
RowHeights[6] := 22;
RowHeights[7] := 22;
RowHeights[8] := 22;
RowHeights[9] := 22;
RowHeights[10] := 22;
RowHeights[11] := 22;
RowHeights[12] := 22;
RowHeights[13] := 22;
RowHeights[14] := 22;
RowHeights[15] := 22;
RowHeights[16] := 22;
Cells[1,0] := 'NAVN '+ ' [' +
FormatDateTime('dd.mmm yyyy',calAvt.Date) + ']';
Cells[0,1] := '08:00';
Cells[0,2] := '08:30';
Cells[0,3] := '09:00';
Cells[0,4] := '09:30';
Cells[0,5] := '10:00';
Cells[0,6] := '10:30';
Cells[0,7] := '11:00';
Cells[0,8] := '11:30';
Cells[0,9] := '12:00';
Cells[0,10] := '12:30';
Cells[0,11] := '13:00';
Cells[0,12] := '13:30';
Cells[0,13] := '14:00';
Cells[0,14] := '14:30';
Cells[0,15] := '15:00';
Cells[0,16] := '15:30';
if (calAvt.Date <> now) then btnToday.Enabled := true;
btnToday.Hint := 'GÅ TIL IDAG!';
btnSpara.Enabled := false;
btnDelete.Enabled := true;
stbAvt.Panels[1].Text := 'Endringer registrert!';
stbAvt.Panels[2].Text := 'OK';
stbAvt.Panels[3].Text := 'Åpen kl.: ' + TimeToStr(Time);
end;
end;
{LAGRE HENDELSER}
procedure TfrmAvt.btnSparaClick(Sender: TObject);
var
f : string;
begin
f := 'C:\BUGS\DATA\' + FormatDateTime('dmyyyy',calAvt.Date) + '.txt';
if not FileExists(f) then begin
SaveGrid(grAvt,f);
grAvt.FixedColor := clMoneyGreen;
grAvt.EditorMode := false;
btnDelete.Enabled := true;
btnSpara.Enabled := false;
stbAvt.Panels[1].Text := 'Endringer registrert!';
stbAvt.Panels[2].Text := 'LAGRET';
stbAvt.Panels[3].Text := 'Registrert kl: ' + TimeToStr(Time);
end
else if FileExists(f) then begin
SaveGrid(grAvt,f);
grAvt.FixedColor := clMoneyGreen;
grAvt.EditorMode := false;
btnDelete.Enabled := false;
btnSpara.Enabled := false;
stbAvt.Panels[1].Text := 'Endringer registrert!';
stbAvt.Panels[2].Text := 'LAGRET';
stbAvt.Panels[3].Text := 'Registrert kl: ' + TimeToStr(Time);
end;
end;
procedure TfrmAvt.grAvtClick(Sender: TObject);
begin
grAvt.EditorMode := true;
btnSpara.Enabled := true;
btnPrint.Enabled := true;
end;
{VELG AVTALE OG SLETT TEKST OG OPPDATER STRINGGRID}
procedure TfrmAvt.grAvtSelectCell(Sender: TObject; ACol, ARow:
Integer;
  var CanSelect: Boolean);
begin
grAvt.EditorMode := true;
btnSpara.Enabled := true;
btnPrint.Enabled := true;
end;
{SLETTE HENDELSER}
procedure TfrmAvt.btnDeleteClick(Sender: TObject);
var
f : String;
i,j : Integer;
begin
f := 'C:\BUGS\DATA\' + FormatDateTime('dmyyyy',calAvt.Date)+'.txt';
if not FileExists(f) then begin
ShowMessage('Ingen fil å slette!' + #13+
UpperCase(FormatDateTime('dddd d.mmm yyyy', calAvt.Date)));
end
else if FileExists(f) then begin
if MessageDlg('SIKKERT AT DU VIL SLETTE: ' +#13+
#13+
UpperCase(FormatDateTime('dddd d.mmm yyyy', calAvt.Date))+'?'+#13+
#13+
'Alle notat for denne dato blir
slettet!',mtConfirmation,[mbYes,mbNo],0)= mrYes then
 try
  DeleteFile(f);
  except
  on E:EInOutError do
  ShowMessage(E.Message);
  end;
grAvt.FixedColor := clRed;
grAvt.EditorMode := false;
btnSpara.Enabled := False;
btnDelete.Enabled := False;
stbAvt.Panels[1].Text := 'Endringer registrert!';
stbAvt.Panels[2].Text := '';
stbAvt.Panels[3].Text := 'SLETTET!' + TimeToStr(Time);
with grAvt do
begin
for i := 0 to ColCount - 1 do
for j := 0 to RowCount - 1 do
begin
Cells[i,j] := '';
FixedColor := clRed;
end;
end;
with grAvt do
begin
ColWidths[1] := 280;
RowHeights[1] := 22;
RowHeights[2] := 22;
RowHeights[3] := 22;
RowHeights[4] := 22;
RowHeights[5] := 22;
RowHeights[6] := 22;
RowHeights[7] := 22;
RowHeights[8] := 22;
RowHeights[9] := 22;
RowHeights[10] := 22;
RowHeights[11] := 22;
RowHeights[12] := 22;
RowHeights[13] := 22;
RowHeights[14] := 22;
RowHeights[15] := 22;
RowHeights[16] := 22;
Cells[1,0] := 'NAVN '+ ' [' +
FormatDateTime('dd.mmm yyyy',calAvt.Date) + ']';
Cells[0,1] := '08:00';
Cells[0,2] := '08:30';
Cells[0,3] := '09:00';
Cells[0,4] := '09:30';
Cells[0,5] := '10:00';
Cells[0,6] := '10:30';
Cells[0,7] := '11:00';
Cells[0,8] := '11:30';
Cells[0,9] := '12:00';
Cells[0,10] := '12:30';
Cells[0,11] := '13:00';
Cells[0,12] := '13:30';
Cells[0,13] := '14:00';
Cells[0,14] := '14:30';
Cells[0,15] := '15:00';
Cells[0,16] := '15:30';
end;
end;
end;
{DIVERSE NYTTIGE HENDELSER}
procedure TfrmAvt.grAvtMouseDown(Sender: TObject; Button:
TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  f:string;
begin
f := 'C:\BUGS\DATA\' + FormatDateTime('dmyyyy',calAvt.Date) + '.txt';
if (Button = mbLeft) then
begin
btnSpara.Enabled := True;
btnDelete.Enabled := True;
grAvt.EditorMode := True;
grAvt.FixedColor := clBtnFace;
end;
end;
{HJELP}
procedure TfrmAvt.btnHelpClick(Sender: TObject);
begin
ShowMessage(
'Klikk kalender,' +#13+
'Klikk avtaletidspunkt' +#13+
'og skriv inn avtale!' +#13+
#13+
'Les forøvrig "Hjelp.txt" i C:\BUGS\');
end;
{HENTE ANDRE SKJEMA}
procedure TfrmAvt.btnAboutClick(Sender: TObject);
begin
try
ShellAbout(
handle,
'BUGS!',
'©Geir Smevig-Baardsen',
Application.Icon.Handle);
except
on E:EInOutError do
ShowMessage(E.Message);
end;
end;
{ENDRE SKJEMASTÖRRELSE}
procedure TfrmAvt.FormResize(Sender: TObject);
begin
try
Width := 640;
Height := 495;
calAvt.Left := 5;
calAvt.Top := 26;
calAvt.Width := 265;
calAvt.Height := 191;
grAvt.Left := 272;
grAvt.Top := 2;
grAvt.Width := 353;
grAvt.Height := 423;
Image1.Left := 5;
Image1.Top := 224;
Image1.Width := 257;
Image1.Height := 209;
stbAvt.Top := 434;
stbAvt.Left := 0;
stbAvt.Width := 632;
stbAvt.Height := 19;
Scaled := false;
except
on E:EInOutError do
ShowMessage(E.Message);
end;
end;
{LUKKE HENDELSER}
procedure TfrmAvt.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmAvt.FormCloseQuery(Sender: TObject; var CanClose:
Boolean);
begin
try
CanClose := MessageDlg(
'Har du husket å lagre?' +#13+
'Vi sees!',
mtConfirmation,[mbYes,mbNo],0) = mrYes;
except
CanClose := False;
end;
end;
procedure TfrmAvt.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
Action := caFree;
Application.Terminate;
end;
{WINDOWS MESSAGING}
procedure TfrmAvt.WmNCHitTest(var Msg: TWMNCHitTest);
begin
  DefaultHandler(Msg);
  try
  if Msg.Result = HTCLIENT then Msg.Result := HTCAPTION;
  except
  on E:EInOutError do
  ShowMessage(E.Message);
  end;
  end;
{VIS HTML-SIDE}
procedure TfrmAvt.SGridToHtml(SG: TStringgrid; Dest: TMemo;
BorderSize: Integer);
var
  i, p: integer;
  SStyle1, SStyle2, Text: string;
begin
Screen.Cursor := crHourGlass;
 try
  Dest.Clear;
  Dest.Lines.Add('<html><head>');
  Dest.Lines.Add('<title> ' + Application.Title + FormatDateTime(' [dd
mmm yyyy]',calAvt.Date) + '</title>');
  Dest.Lines.Add('<body bgColor="#ffffff" topmargin="0"
leftmargin="0">');
  Dest.Lines.Add('<img src="C:\BUGS\Logo.bmp" border="0">');
  Dest.Lines.Add('<hr width="80%" size="2" color="#c0c0c0">');
  Dest.Lines.Add('<center>');
  Dest.Lines.Add('<table border="' + IntToStr(BorderSize) + '"
width="' +
    IntToStr(SG.Width) + '" height="' + IntToStr(SG.Width) + '">');
    for i := 0 to SG.RowCount - 1 do
    begin
    Dest.Lines.Add('<tr>');
    for p := 0 to SG.ColCount - 1 do
    begin
      SStyle1 := '';
      SStyle2 := '';
      if fsbold in SG.Font.Style then
      begin
        SStyle1 := SStyle1 + '<b>';
        SStyle2 := SStyle2 + '</b>';
      end;
      if fsitalic in SG.Font.Style then
      begin
        SStyle1 := SStyle1 + '<i>';
        SStyle2 := SStyle2 + '</i>';
      end;
      if fsunderline in SG.Font.Style then
      begin
        SStyle1 := SStyle1 + '<u>';
        SStyle2 := SStyle2 + '</u>';
      end;
      Text := sg.Cells[p, i];
      if Text = '' then Text := ' ';
      Dest.Lines.Add('<td width="' + IntToStr(sg.ColWidths[p]) +
        '" height="' + IntToStr(sg.RowHeights[p]) +'"><font
color="#000000"' +
         'face="' + SG.Font.Name + '">' + SStyle1 +
        Text + SStyle2 + '</font></td>');
        end;
    Dest.Lines.Add('</tr>');
  end;
  Dest.Lines.Add('</table>');
  Dest.Lines.Add('</p>');
  Dest.Lines.Add('<p>');
  Dest.Lines.Add('Geir Smevig-Baardsen - ©All Rights 2003');
  Dest.Lines.Add('<br>');
  Dest.Lines.Add('www • <a
href="mailto:almpio@start.no" title="Send en mail!">Epost</a>');
  Dest.Lines.Add('<br>');
  Dest.Lines.Add('Delphi 7 • MS Access 2000 databaseutvikling');
  Dest.Lines.Add('</center>');
  Dest.Lines.Add('</p>');
  Dest.Lines.Add('</body>');;
  Dest.Lines.Add('</html>');
  except
  on E:EInOutError do ShowMessage(E.Message);
  end;
  Screen.Cursor := crDefault;
end;
procedure TfrmAvt.btnVisHtmlClick(Sender: TObject);
var
f:string;
begin
f := 'C:\BUGS\GB.html';
Screen.Cursor := crHourGlass;
try
  if FileExists(f) then DeleteFile(f);
   SGridToHtml(grAvt, Memo1, 1);
    Memo1.Lines.SaveToFile(f);
  except
  on E:EInOutError do
  ShowMessage(E.Message);
  end;
  Screen.Cursor := crDefault;
  if FileExists(f) then begin
  Screen.Cursor := crHourGlass;
  try
  ShellExecute(Handle,'Open','C:\BUGS\GB.html',nil,nil,SW_SHOWMAXIMIZED);
  except
  on E:EInOutError do
  ShowMessage(E.Message);
  end;
  Screen.Cursor := crDefault;
  end;
end;
{REKLAMEN}
procedure TfrmAvt.btnPersInfoClick(Sender: TObject);
begin
ShowMessage(
'Geir Smevig-Baardsen' +#13+
'Delphi 7 - MS Access 2000 databaseutvikling' +#13+
'almpio@start.no' +#13+
'http://')
end;
{FJERN LEDETEKST FRA KALENDERS ONMOUSEOVER}
procedure TfrmAvt.calAvtContextPopup(Sender: TObject; MousePos:
TPoint;
  var Handled: Boolean);
begin
Handled := true;
end;
{SKRIV-PROSEDYRE}
procedure TfrmAvt.PrintStringGrid(Grid: TStringGrid; Title: string;
  Orientation: TPrinterOrientation);
var
  P, I, J, YPos, XPos, HorzSize, VertSize: Integer;
  AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize,
FontHeight: Integer;
  mmx, mmy: Extended;
  Footer: string;
begin
  //Kopfzeile, Fußzeile, Zeilenabstand, Schriftgröße festlegen
  HeaderSize := 100;
  FooterSize := 200;
  ZeilenSize := 36;
  FontHeight := 36;
  //Printer initializieren
  Printer.Orientation := Orientation;
  Printer.Title := Title;
  Printer.BeginDoc;
  //Druck auf mm einstellen
  mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
  mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;

  VertSize := Trunc(mmy) * 10;
  HorzSize := Trunc(mmx) * 10;
  SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);

  //Zeilenanzahl festlegen
  Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize;
  //Seitenanzahl ermitteln
  if Grid.RowCount mod Zeilen <> 0 then
    AnzSeiten := Grid.RowCount div Zeilen + 1
  else
    AnzSeiten := Grid.RowCount div Zeilen;

  Seite := 1;
  //Grid Drucken
  for P := 1 to AnzSeiten do
  begin
    //Kopfzeile
    Printer.Canvas.Font.Height := 48;
    Printer.Canvas.TextOut((HorzSize div 2 -
(Printer.Canvas.TextWidth(Title) div 2)),
      - 20,Title);
    Printer.Canvas.Pen.Width := 5;
    Printer.Canvas.MoveTo(0, - HeaderSize);
    Printer.Canvas.LineTo(HorzSize, - HeaderSize);
    //Fußzeile
    Printer.Canvas.MoveTo(0, - VertSize + FooterSize);
    Printer.Canvas.LineTo(HorzSize, - VertSize + FooterSize);
    Printer.Canvas.Font.Height := 36;
    Footer := 'Side: ' + IntToStr(Seite) + '/' + IntToStr(AnzSeiten);
    Printer.Canvas.TextOut((HorzSize div 2 -
(Printer.Canvas.TextWidth(Footer) div 2)),
      - VertSize + 150,Footer);
    //Zeilen drucken
    Printer.Canvas.Font.Height := FontHeight;
    YPos := HeaderSize + 10;
    for I := 1 to Zeilen do
    begin
      if Grid.RowCount >= I + (Seite - 1) * Zeilen then
      begin
        XPos := 0;
        for J := 0 to Grid.ColCount - 1 do
        begin
          Printer.Canvas.TextOut(XPos, - YPos,
            Grid.Cells[J, I + (Seite - 1) * Zeilen - 1]);
          XPos := XPos + Grid.ColWidths[J] * 3;
        end;
        YPos := YPos + ZeilenSize;
      end;
    end;
    //Seite hinzufügen
    Inc(Seite);
    if Seite <= AnzSeiten then Printer.NewPage;
  end;
  Printer.EndDoc;
end;
procedure TfrmAvt.btnPrintClick(Sender: TObject);
begin
try
PrintStringGrid(grAvt, 'DAGENS AVTALER!' +
FormatDateTime(' [dd mmm yyyy]',calAvt.Date), poPortrait);
except
on E:EInOutError do
ShowMessage(E.Message);
end;
end;
end.

Any suggestion how to improve with these standard components is
greatly acknowledged. This project was made in Delphi 6 and is being
updated in the Delphi 7 PE.

• Previous message: pr: "Re: Can't access to numerial fields using adoquery ..."
• Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]