создание компилятора - [2] :: Прикладное программирование

Цитата:

Для решения одной задачи встала задача создания собственного макро-языка. Нужна возможность создания макросов которые затем компилируются в бинарный код. Как к такой задаче подступиться?

От формата Лист Microsoft Excel, бинарнее не бывает.

Добавлено:
Макросы превращаемые в бинарный код могут зависеть от бинарного кода, тобишь какой тебе код нужен (для процессора или препроцессора, а может ещё для чего).
Почитал тут про оптимизацию размера программы, прога получилась на 200kb, любое количество маленьких экранчиков поверх телика. Делать её в один день можно.
Напоминаю:
1.Если нет каких компонентов - кнопка игноре.
2.Если текст не компилируется внимательно удаляем.
3.Если размеры экранчика не совпадают с размерами предметов используются первые два правила иначе не понять к чему я веду мысль.

Код:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, MPlayer,
ExtCtrls, Menus, ComCtrls, PinClasses, PinValues, PinRegValues, pinShell,
XPMan;

type
TForm1 = class(TForm)
Exit1: TMenuItem;
File1: TMenuItem;
Link1: TPinRLink;
MediaPlayer1: TMediaPlayer;
N1: TMenuItem;
N11: TMenuItem;
N121: TMenuItem;
N15x11: TMenuItem;
New1: TMenuItem;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
PopupMenu1: TPopupMenu;
RegBoolean1: TPinRegBoolean;
RegistryValues1: TPinRegistryValues;
RegString1: TPinRegString;
Stayontop1: TMenuItem;
Timer1: TTimer;
TrackBar1: TTrackBar;
XPManifest1: TXPManifest;
Zoom1: TMenuItem;
procedure Exit1Click(Sender: TObject);
procedure File1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
procedure MediaPlayer1Notify(Sender: TObject);
procedure MediaPlayer1PostClick(Sender: TObject; Button: TMPBtnType);
procedure N11Click(Sender: TObject);
procedure N121Click(Sender: TObject);
procedure N15x11Click(Sender: TObject);
procedure New1Click(Sender: TObject);
procedure Panel1DblClick(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PopupMenu1Popup(Sender: TObject);
procedure Stayontop1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
fdrag: boolean;
fdx, fdy: Integer;
fk: Double;
fr: TRect;
public
procedure MOpen;
procedure MPlay;
end;

var
Form1: TForm1;

implementation

uses Types;

{$R *.dfm}

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.File1Click(Sender: TObject);
begin
OpenDialog1.InitialDir := ExtractFileDir(RegString1.Value);
if not OpenDialog1.Execute then exit;
Panel1.Caption := OpenDialog1.FileName;
RegString1.Value := Panel1.Caption;
MOpen;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if RegBoolean1.Value then FormStyle := fsStayOnTop;
fk := 1/2;
Panel1.Caption := RegString1.Value;
if FileExists(Panel1.Caption) then MOpen;
end;

procedure TForm1.MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
begin
if Button <> btPlay then exit;
MPlay;
end;

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
if MediaPlayer1.NotifyValue <> nvSuccessful then exit;
MediaPlayer1.Play;
end;

procedure TForm1.MediaPlayer1PostClick(Sender: TObject;
Button: TMPBtnType);
begin
if Button <> btPlay then exit;
TrackBar1.Max := MediaPlayer1.Length;
end;

procedure TForm1.MOpen;
begin
MediaPlayer1.Close;
fr.Right := 0;
Caption := ExtractFileName(Panel1.Caption);
Application.Title := Caption;
MediaPlayer1.FileName := Panel1.Caption;
MediaPlayer1.Visible := True;
MediaPlayer1.Open;
end;

procedure TForm1.MPlay;
var
R: TRect;
begin
if fr.Right = 0 then
fr := MediaPlayer1.DisplayRect;
if WindowState = wsMaximized then begin
R := Panel1.ClientRect;
end else begin
R := fr;
R.Right := Round(R.Right*fk);
R.Bottom := Round(R.Bottom*fk);
ClientWidth := R.Right;
ClientHeight := R.Bottom + TrackBar1.Height;
end;
MediaPlayer1.DisplayRect := R;
MediaPlayer1.Visible := false;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
fk:=1; MPlay;
end;

procedure TForm1.N121Click(Sender: TObject);
begin
fk:=1/2; MPlay;
end;

procedure TForm1.N15x11Click(Sender: TObject);
begin
fk:=2/3; MPlay;
end;

procedure TForm1.New1Click(Sender: TObject);
begin
Link1.Link := ParamStr(0);
Link1.Run;
end;

procedure TForm1.Panel1DblClick(Sender: TObject);
begin
fdrag := false;
if WindowState <> wsMaximized then WindowState := wsMaximized
else WindowState := wsNormal;
MPlay;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fdrag := not (ssDouble in Shift) and (WindowState <> wsMaximized);
fdx := X; fdy := Y;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not fdrag then exit;
Y := fdy - Y; X := fdx - X;
Left := Left - X;
Top := Top - Y;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fdrag := False;
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
Stayontop1.Checked := FormStyle = fsStayOnTop;
end;

procedure TForm1.Stayontop1Click(Sender: TObject);
begin
MediaPlayer1.Display := nil;
try Sleep(10);
if FormStyle = fsStayOnTop then FormStyle := fsNormal
else FormStyle := fsStayOnTop;
RegBoolean1.Value := FormStyle = fsStayOnTop;
finally MediaPlayer1.Display := Panel1;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if MediaPlayer1.Mode <> mpPlaying then exit;
TrackBar1.OnChange := nil;
try TrackBar1.Position := MediaPlayer1.Position;
finally TrackBar1.OnChange := TrackBar1Change;
end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
MediaPlayer1.Visible := true;
MediaPlayer1.Position := TrackBar1.Position;
end;

end.

object Form1: TForm1
Left = 40
Top = 128
BorderStyle = bsNone
Caption = 'Form1'
ClientHeight = 303
ClientWidth = 326
Color = clAppWorkSpace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OnCreate = FormCreate
object Panel1: TPanel
Left = 0
Top = 0
Width = 326
Height = 286
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 0
OnDblClick = Panel1DblClick
OnMouseDown = Panel1MouseDown
OnMouseMove = Panel1MouseMove
OnMouseUp = Panel1MouseUp
end
object MediaPlayer1: TMediaPlayer
Left = 3
Top = 264
Width = 197
Height = 20
ColoredButtons = [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack]
VisibleButtons = [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack]
Anchors = [akLeft, akBottom]
Display = Panel1
TabOrder = 1
OnClick = MediaPlayer1Click
OnPostClick = MediaPlayer1PostClick
OnNotify = MediaPlayer1Notify
end
object TrackBar1: TTrackBar
Left = 0
Top = 286
Width = 326
Height = 17
Align = alBottom
PopupMenu = PopupMenu1
TabOrder = 2
ThumbLength = 14
OnChange = TrackBar1Change
end
object OpenDialog1: TOpenDialog
Left = 256
Top = 256
end
object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup
Left = 224
Top = 256
object File1: TMenuItem
Caption = 'File'
OnClick = File1Click
end
object Zoom1: TMenuItem
Caption = 'Zoom'
object N121: TMenuItem
Caption = '2x1'
OnClick = N121Click
end
object N15x11: TMenuItem
Caption = '1.5x1'
OnClick = N15x11Click
end
object N11: TMenuItem
Caption = '1x1'
OnClick = N11Click
end
end
object Stayontop1: TMenuItem
Caption = 'Stay on top'
OnClick = Stayontop1Click
end
object New1: TMenuItem
Caption = 'New'
OnClick = New1Click
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = 'Exit'
OnClick = Exit1Click
end
end
object Timer1: TTimer
Interval = 40
OnTimer = Timer1Timer
Left = 288
Top = 256
end
object RegistryValues1: TPinRegistryValues
ReadOnly = False
Relative = 'Software\Microsoft\Windows'
Left = 224
Top = 224
object RegBoolean1: TPinRegBoolean
Reg.ValueName = 'mplaytop'
end
object RegString1: TPinRegString
Reg.ValueName = 'mplaydir'
end
end
object XPManifest1: TXPManifest
Left = 256
Top = 224
end
object Link1: TPinRLink
Items = <>
Left = 288
Top = 224
end
end

Модерирует : ShIvADeSt
Версия для печати • Подписаться • Добавить в закладки
Страницы: 1 2 3