main.pas

電子看板的物件程式

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  BBoard, StdCtrls, Grids, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel1: TPanel;
    btLoad_: TButton;
    btSave_: TButton;
    btDone_: TButton;
    Bevel13: TBevel;
    Bevel14: TBevel;
    Bevel15: TBevel;
    Bevel16: TBevel;
    Bevel17: TBevel;
    Bevel18: TBevel;
    Panel5: TPanel;
    Bevel8: TBevel;
    bb_ruler: TBillBoard;
    ScrollBar: TScrollBar;
    Panel6: TPanel;
    bb_editing: TBillBoard;
    btExit_: TButton;
    HeaderControl: THeaderControl;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btSave_Click(Sender: TObject);
    procedure btLoad_Click(Sender: TObject);
    procedure HeaderControlSectionClick(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure btExit_Click(Sender: TObject);
    procedure bb_editingMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bb_editingMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btDone_Click(Sender: TObject);
    procedure ScrollBarChange(Sender: TObject);
  private
    { Private declarations }
    function 	CheckCharset: Word;
		function 	GetDecimal( Value: string ): integer;
    procedure LoadList;
    procedure RulerFromChar( Value: integer );
    procedure SetCell( Value: TPoint );
  public
    { Public declarations }
  end;

const

	HexCode: array[ 0..15 ] of char = '0123456789ABCDEF';
  Title: string = 'Charset Generator - ';

var
  Form1: TForm1;
  List: TStringList;
  CSFile: Textfile;
  FileName: string;
  CurrentChar: integer;
  CurrentPos: integer;
  PointClicked: TPoint;
  CharSetChanged : Boolean;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin

	List := TStringList.Create;
	LoadList;
  FileName := 'untitled.txt';
  Caption := Title + FileName;
  CurrentChar := 0;
  CurrentPos := 0;
  ScrollBar.Position := CurrentPos;
	RulerFromChar( CurrentPos );
	bb_editing.Text := Chr( CurrentChar );
  PointClicked := Point( -1, -1 );
  CharSetChanged := false;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

	if( Assigned( List ) ) then
  	List.Free;

end;

procedure TForm1.btExit_Click(Sender: TObject);
begin

	Close;

end;

procedure TForm1.btDone_Click(Sender: TObject);
begin

  if( CheckCharset = id_Cancel ) then
  	Exit
	else
  	Close;

end;

procedure TForm1.btLoad_Click(Sender: TObject);
var
	i,j,p: integer;
  s: string;
begin

  if( CheckCharset = id_Cancel ) then
  	Exit;

	if( OpenDialog.Execute ) then
  	begin
      AssignFile( CSFile, OpenDialog.FileName );
      Reset( CSFile );
      i := 0;
    	List.Clear;
      while( ( i < 256 ) and ( not( Eof( CSFile ) ) ) ) do
      	begin
      		Readln( CSFile, s );
      		List.Add( UpperCase( s ) );
          inc( i );
        end;
      FileName := OpenDialog.FileName;
      CloseFile( CSFile );
      for i := 0 to 255 do
        begin
          s := List.Strings[ i ];
          for j := 8 downto 0 do
            begin
              p := LastDelimiter( '$', s );
              bb_editing.Charset.Item[ i, j ] := byte( GetDecimal( Copy( s, p + 1, 2 ) ) );
              s := Copy( s, 1, p - 1 );
            end;
        end;
      CharSetChanged := false;
    end;

  bb_ruler.Charset := bb_editing.Charset;
  bb_editing.Refresh;
  bb_ruler.Refresh;
  Caption := Title + FileName;

end;

procedure TForm1.btSave_Click(Sender: TObject);
var
	i: integer;
begin

	SaveDialog.FileName := FileName;

	if( SaveDialog.Execute ) then
  	begin
      AssignFile( CSFile, SaveDialog.FileName );
      Rewrite( CSFile );
      LoadList;
      for i := 0 to 255 do
      	Writeln( CSFile, List.Strings[ i ] );
      FileName := SaveDialog.FileName;
      CloseFile( CSFile );
  		CharSetChanged := false;
    end;

  Caption := Title + FileName;

end;

procedure TForm1.ScrollBarChange(Sender: TObject);
begin

	CurrentPos := ScrollBar.Position;
	RulerFromChar( CurrentPos );

end;

procedure TForm1.ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
																	var ScrollPos: Integer);
begin

	case ScrollCode of

  	scLineUp		:	dec( CurrentPos );
    scLineDown	:	inc( CurrentPos );
    scPageUp		:	dec( CurrentPos, 8 );
    scPageDown	:	inc( CurrentPos, 8 );
    scTop				:	CurrentPos := 0;
    scBottom		:	CurrentPos := 248;

  end;

  	if( CurrentPos < 0 ) then
    	CurrentPos := 0
    else
    	if( CurrentPos > 248 ) then
      	CurrentPos := 248;

  bb_ruler.Charset := bb_editing.Charset;
  RulerFromChar( CurrentPos );

end;

procedure TForm1.HeaderControlSectionClick(HeaderControl: THeaderControl;
																						Section: THeaderSection);
begin

	CurrentChar := GetDecimal( Copy( Section.Text, 2, 2 ) );
	bb_editing.Text := Chr( CurrentChar );
  bb_ruler.Charset := bb_editing.Charset;
  RulerFromChar( CurrentPos );
  bb_ruler.Refresh;

end;

procedure TForm1.bb_editingMouseDown(Sender: TObject; Button: TMouseButton;
  																		Shift: TShiftState; X, Y: Integer);
begin

	PointClicked.x := X div bb_editing.CellSize;
  PointClicked.y := Y div bb_editing.CellSize;

end;

procedure TForm1.bb_editingMouseUp(Sender: TObject; Button: TMouseButton;
  																	Shift: TShiftState; X, Y: Integer);
begin

	if( ( PointClicked.x = ( X div bb_editing.CellSize ) ) and
  		( PointClicked.y = ( Y div bb_editing.CellSize ) ) ) then
		begin
    	SetCell( PointClicked );
    end
  else
  	begin
      PointClicked.y := -1;
      PointClicked.x := -1;
    end;

end;

procedure TForm1.LoadList;
var
	i,j,n	: integer;
  s			: string;
begin

	List.Clear;

  for i := 0 to 255 do
  	begin
    	s := '( ';
  		for j := 0 to 8 do
      	begin
        	s := s + '$';
          n := integer( bb_editing.Charset.Item[ i,j ] );
          s := s + HexCode[ n div 16 ] + HexCode[ n mod 16 ];
          if( j < 8 ) then
          	s := s + ', ';
        end;
      if( i < 255 ) then
      	s := s + ' ),'
      else
      	s := s + ' )';
      List.Add( s );
    end;

end;

function TForm1.GetDecimal( Value: string ): integer;
var
	i: integer;
begin

  if( ( Value[ 1 ] >= '0' ) and ( Value[ 1 ] <= '9' ) ) then
    i := integer( ( Ord( Value[ 1 ] ) - 48 ) * 16 )
  else
    i := integer( ( Ord( Value[ 1 ] ) - 55 ) * 16 );

  if( ( Value[ 2 ] >= '0' ) and ( Value[ 2 ] <= '9' ) ) then
    i := i + integer( Ord( Value[ 2 ] ) - 48 )
  else
    i := i + integer( Ord( Value[ 2 ] ) - 55 );

  Result := i;

end;

procedure TForm1.RulerFromChar( Value: integer );
var
	i,j: integer;
  s,s1: string;
begin

	s := '';
  j := 0;
	for i := Value to Value + 7 do
  	begin
  		s := s + Char( i );
      s1 := '$' + HexCode[ i div 16 ] + HexCode[ i mod 16 ];
      HeaderControl.Sections[ j ].Text := s1;
      inc( j );
    end;

  bb_ruler.Text := s;

end;

procedure TForm1.SetCell( Value: TPoint );
var
	b,c: Byte;
begin

	b := $40 shr Value.x;
  c := bb_editing.Charset.Item[ CurrentChar, Value.y ];

	if( ( c and b ) <> 0 ) then
  	bb_editing.Charset.Item[ CurrentChar, Value.y ] := ( c and not( b ) )
  else
  	bb_editing.Charset.Item[ CurrentChar, Value.y ] := ( c or b );

	bb_editing.Refresh;
  CharSetChanged := true;

end;

function TForm1.CheckCharset: Word;
begin

	Result := id_No;

	if( CharSetChanged ) then
		begin
    	Result := MessageDlg('Charset changed. Save?', mtWarning, mbYesNoCancel, 0);
  		Case Result of
        id_Yes		:	btSave_Click( Self );
      end;
    end;

end;

end.