We help IT Professionals succeed at work.

Test the example

Peter Kiers
Peter Kiers asked
on
613 Views
Last Modified: 2013-11-05
Dear Experts,

I have received this example from Ziolko:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var
        Resize: Boolean);
    procedure FormPaint(Sender: TObject);
  private
    FCellWidth: Integer;
    FCellHeight: Integer;
    procedure FillCell(ARowIdx, AColIdx: Integer);
    procedure DoPaint;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
const
      COL_COUNT = 80;
      ROW_COUNT = 25;

procedure TForm1.DoPaint;
var cnt: Integer;
begin
  Canvas.Lock;
  try
    Canvas.Brush.Color := Color;
    Canvas.FillRect(ClientRect);
    for cnt := 0 to ROW_COUNT do
      FillCell(cnt, 40);
  finally
    Canvas.Unlock;
  end;
end;

procedure TForm1.FillCell(ARowIdx, AColIdx: Integer);
var r: TRect;
begin
  r.Left := AColIdx * FCellWidth;
  r.Top := ARowIdx * FCellHeight;
  r.Right := r.Left + FCellWidth;
  r.Bottom := r.Top + FCellHeight;
  Canvas.Brush.Color := clBlack;
  Canvas.FillRect(r);
end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth, NewHeight:
    Integer; var Resize: Boolean);
begin
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  FCellWidth := ClientWidth div COL_COUNT;
  FCellHeight := ClientHeight div ROW_COUNT;
  DoPaint;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DoPaint;
end;

end.

I want to fill the whole canvas with characters when I
click on menu-item Fill Canvas. Because I want to test the
example above. Does someone know how to do this?
P.
Comment
Watch Question

Top Expert 2007
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Top Expert 2007

Commented:
Here's a complete example of this very basic approach that simply paints the characters on the canvas. As I said, probably not what you want. The biggest difference is that you don't have a fixed number of rows and columns. The size of the chars is fixed while resizing and the number of rows and cols will vary, and I guess you'd rather have the letters themselves resize. If this was already considered and dismissed since working on this program, then simply disregard it please :)
However, just as an example.
But you clearly cannot test Ziolko's solution with it, as the approach is different.


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    ools1: TMenuItem;
    FillCanvas1: TMenuItem;
    procedure FillCanvas1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    DoFillCanvas:Boolean;
    procedure FillCanvas();
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}

procedure TForm1.FillCanvas();
var
i,j,w,h,tw,th,min,max,ch:Integer;
begin
  if DoFillCanvas then begin
    w:=Canvas.ClipRect.Right-Canvas.ClipRect.Left;
    h:=Canvas.ClipRect.Bottom-Canvas.ClipRect.Top;
    tw:=Canvas.TextWidth('W');
    th:=Canvas.TextHeight('Y');
    min:=40;
    max:=125;
    Caption:=IntToStr(w div tw)  +'  / '+ IntToStr(h div th);
    Canvas.Font.Style:=[fsBold];
    Canvas.Brush.Color:=clBlack;
    Canvas.FillRect(Canvas.ClipRect);
    Canvas.Font.Color:=clGreen;
    ch:=min;
    for i:=0 to (h div th ) do begin
       for j:=0 to (w div tw ) do begin
           Canvas.TextOut(j*tw, i*th, Char(ch));
           Inc(ch);
           if ch>max then ch :=min;
       end;
    end;
  end;
end;

procedure TForm1.FillCanvas1Click(Sender: TObject);
begin
  DoFillCanvas:=True;
  FillCanvas;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
   FillCanvas;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=True;
  DoFillCanvas:=False;
end;

end.
Peter KiersOperator

Author

Commented:
Thanks TName

Peter Kiers
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.