mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-15 01:19:29 +02:00
fixed setting project LCLWidgetSet in defines
git-svn-id: trunk@5313 -
This commit is contained in:
mattias
parent
558acd0963
commit
70c99062d7
@ -2054,6 +2054,7 @@ var
|
||||
MacroParam: string;
|
||||
OldMacroLen: Integer;
|
||||
Handled: Boolean;
|
||||
MacroVarName: String;
|
||||
begin
|
||||
Result:=false;
|
||||
MacroFuncNameEnd:=MacroEnd;
|
||||
@ -2071,17 +2072,18 @@ var
|
||||
MacroStr:=ExecuteMacroFunction(MacroFuncName,MacroParam);
|
||||
end else begin
|
||||
// Macro variable
|
||||
MacroStr:=copy(CurValue,MacroStart+2,MacroEnd-MacroStart-3);
|
||||
//writeln('**** MacroStr=',MacroStr);
|
||||
MacroVarName:=copy(CurValue,MacroStart+2,MacroEnd-MacroStart-3);
|
||||
MacroStr:=MacroVarName;
|
||||
//writeln('**** MacroVarName=',MacroVarName,' ',DirDef.Values.Variables[MacroVarName]);
|
||||
//writeln('DirDef.Values=',DirDef.Values.AsString);
|
||||
if MacroStr=DefinePathMacroName then begin
|
||||
if MacroVarName=DefinePathMacroName then begin
|
||||
MacroStr:=CurDefinePath;
|
||||
end else if DirDef.Values.IsDefined(MacroStr) then begin
|
||||
MacroStr:=DirDef.Values.Variables[MacroStr];
|
||||
end else if DirDef.Values.IsDefined(MacroVarName) then begin
|
||||
MacroStr:=DirDef.Values.Variables[MacroVarName];
|
||||
end else begin
|
||||
Handled:=false;
|
||||
if Assigned(FOnReadValue) then begin
|
||||
MacroParam:=MacroStr;
|
||||
MacroParam:=MacroVarName;
|
||||
MacroStr:='';
|
||||
FOnReadValue(Self,MacroParam,MacroStr,Handled);
|
||||
end;
|
||||
@ -2092,7 +2094,6 @@ var
|
||||
MacroStr:='';
|
||||
end;
|
||||
end;
|
||||
//writeln('**** NewValue MacroStr=',MacroStr);
|
||||
end;
|
||||
NewMacroLen:=length(MacroStr);
|
||||
GrowBuffer(BufferPos+NewMacroLen-OldMacroLen+ValueLen-ValuePos+1);
|
||||
|
||||
@ -329,6 +329,7 @@ type
|
||||
function ShortenPath(const SearchPath: string;
|
||||
MakeAlwaysRelative: boolean): string;
|
||||
function GetCustomOptions: string;
|
||||
function GetEffectiveLCLWidgetType: string;
|
||||
public
|
||||
{ Properties }
|
||||
property Owner: TObject read fOwner write fOwner;
|
||||
@ -1644,6 +1645,13 @@ begin
|
||||
Result:=SpecialCharsToSpaces(Result);
|
||||
end;
|
||||
|
||||
function TBaseCompilerOptions.GetEffectiveLCLWidgetType: string;
|
||||
begin
|
||||
Result:=LCLWidgetType;
|
||||
if (Result='') or (Result='default') then
|
||||
Result:=GetDefaultLCLWidgetType;
|
||||
end;
|
||||
|
||||
function TBaseCompilerOptions.ShortenPath(const SearchPath: string;
|
||||
MakeAlwaysRelative: boolean): string;
|
||||
begin
|
||||
@ -4709,7 +4717,7 @@ begin
|
||||
Top:= y;
|
||||
Width:=Self.ClientWidth-28;
|
||||
Height:=45;
|
||||
Caption:=dlgLCLWidgetType;
|
||||
Caption:=lisLCLWidgetType;
|
||||
with Items do begin
|
||||
Add(Format(lisCOdefault, [GetDefaultLCLWidgetType]));
|
||||
Add('gnome');
|
||||
|
||||
@ -898,7 +898,6 @@ resourcestring
|
||||
lisCOScanForMakeMessages = 'Scan for Make messages';
|
||||
lisCOShowAllMessages = 'Show all messages';
|
||||
dlgUnitOutp = 'Unit output directory:';
|
||||
dlgLCLWidgetType = 'LCL Widget Type';
|
||||
lisCOdefault = 'default (%s)';
|
||||
dlgButApply = 'Apply';
|
||||
dlgCOShowOptions = 'Show Options';
|
||||
|
||||
39
ide/main.pp
39
ide/main.pp
@ -5180,7 +5180,7 @@ Begin
|
||||
Project1.Units[i].Modified:=false;
|
||||
Project1.Modified:=false;
|
||||
|
||||
writeln('TMainIDE.DoNewProject end ',CodeToolBoss.ConsistencyCheck);
|
||||
writeln('TMainIDE.DoNewProject end ');
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
@ -7295,115 +7295,95 @@ begin
|
||||
exit;
|
||||
end;
|
||||
MacroName:=lowercase(TheMacro.Name);
|
||||
if MacroName='save' then begin
|
||||
Handled:=true;
|
||||
if MacroName='save' then begin
|
||||
if (SourceNoteBook<>nil) and (SourceNoteBook.NoteBook<>nil) then
|
||||
Abort:=(DoSaveEditorFile(SourceNoteBook.NoteBook.PageIndex,
|
||||
[sfCheckAmbigiousFiles])<>mrOk);
|
||||
s:='';
|
||||
end else if MacroName='saveall' then begin
|
||||
Handled:=true;
|
||||
Abort:=(DoSaveAll([sfCheckAmbigiousFiles])<>mrOk);
|
||||
s:='';
|
||||
end else if MacroName='edfile' then begin
|
||||
Handled:=true;
|
||||
if (SourceNoteBook<>nil) and (SourceNoteBook.NoteBook<>nil) then
|
||||
s:=Project1.UnitWithEditorIndex(SourceNoteBook.NoteBook.PageIndex).Filename
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='col' then begin
|
||||
Handled:=true;
|
||||
if (SourceNoteBook<>nil) and (SourceNoteBook.NoteBook<>nil) then
|
||||
s:=IntToStr(SourceNoteBook.GetActiveSE.EditorComponent.CaretX);
|
||||
end else if MacroName='row' then begin
|
||||
Handled:=true;
|
||||
if (SourceNoteBook<>nil) and (SourceNoteBook.NoteBook<>nil) then
|
||||
s:=IntToStr(SourceNoteBook.GetActiveSE.EditorComponent.CaretY);
|
||||
end else if MacroName='projfile' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.MainFilename
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='projpath' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.ProjectDirectory
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='projunitpath' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.CompilerOptions.GetUnitPath(false)
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='projincpath' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.CompilerOptions.GetIncludePath(false)
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='projsrcpath' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.CompilerOptions.GetSrcPath(false)
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='projpublishdir' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.PublishOptions.DestinationDirectory
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='curtoken' then begin
|
||||
Handled:=true;
|
||||
if (SourceNoteBook<>nil) and (SourceNoteBook.NoteBook<>nil) then
|
||||
with SourceNoteBook.GetActiveSE.EditorComponent do
|
||||
s:=GetWordAtRowCol(CaretXY);
|
||||
end else if MacroName='lazarusdir' then begin
|
||||
Handled:=true;
|
||||
s:=EnvironmentOptions.LazarusDirectory;
|
||||
end else if MacroName='lclwidgettype' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.CompilerOptions.LCLWidgetType
|
||||
else
|
||||
s:='';
|
||||
if (s='') or (s='default') then s:=GetDefaultLCLWidgetType;
|
||||
end else if MacroName='targetcpu' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=lowercase(Project1.CompilerOptions.TargetCPU)
|
||||
else
|
||||
s:='';
|
||||
if (s='') or (s='default') then s:=GetDefaultTargetCPU;
|
||||
end else if MacroName='targetos' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=lowercase(Project1.CompilerOptions.TargetOS)
|
||||
else
|
||||
s:='';
|
||||
if (s='') or (s='default') then s:=GetDefaultTargetOS;
|
||||
end else if MacroName='fpcsrcdir' then begin
|
||||
Handled:=true;
|
||||
s:=EnvironmentOptions.FPCSourceDirectory;
|
||||
end else if MacroName='comppath' then begin
|
||||
Handled:=true;
|
||||
s:=EnvironmentOptions.CompilerFilename;
|
||||
end else if MacroName='params' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=Project1.RunParameterOptions.CmdLineParams
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='targetfile' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=GetProjectTargetFilename
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='targetcmdline' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then begin
|
||||
s:=Project1.RunParameterOptions.CmdLineParams;
|
||||
if s='' then
|
||||
@ -7413,27 +7393,24 @@ begin
|
||||
end else
|
||||
s:='';
|
||||
end else if MacroName='testdir' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=GetTestBuildDir
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='runcmdline' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=GetRunCommandLine
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='projpublishdir' then begin
|
||||
Handled:=true;
|
||||
if Project1<>nil then
|
||||
s:=GetProjPublishDir
|
||||
else
|
||||
s:='';
|
||||
end else if MacroName='confdir' then begin
|
||||
Handled:=true;
|
||||
s:=GetPrimaryConfigPath;
|
||||
end;
|
||||
end else
|
||||
Handled:=false;
|
||||
end;
|
||||
|
||||
function TMainIDE.OnSubstituteCompilerOption(Options: TParsedCompilerOptions;
|
||||
@ -8371,7 +8348,7 @@ begin
|
||||
EnvironmentOptions.LazarusDirectory;
|
||||
Variables[ExternalMacroStart+'FPCSrcDir']:=
|
||||
EnvironmentOptions.FPCSourceDirectory;
|
||||
Variables[ExternalMacroStart+'LCLWidgetType']:='gtk';
|
||||
Variables[ExternalMacroStart+'LCLWidgetType']:=GetDefaultLCLWidgetType;
|
||||
Variables[ExternalMacroStart+'ProjPath']:=VirtualDirectory;
|
||||
end;
|
||||
|
||||
@ -10273,7 +10250,7 @@ begin
|
||||
end
|
||||
else if (not (ALayout.WindowPlacement in [iwpDocked,iwpUseWindowManagerSetting]))
|
||||
then begin
|
||||
// default position
|
||||
// default window positions
|
||||
l:=NonModalIDEFormIDToEnum(ALayout.FormID);
|
||||
case l of
|
||||
nmiwMainIDEName:
|
||||
@ -10329,7 +10306,6 @@ end;
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
initialization
|
||||
{ $I mainide.lrs}
|
||||
{$I images/laz_images.lrs}
|
||||
{$I images/mainicon.lrs}
|
||||
ShowSplashScreen:=true;
|
||||
@ -10339,6 +10315,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.717 2004/03/17 11:28:35 mattias
|
||||
fixed setting project LCLWidgetSet in defines
|
||||
|
||||
Revision 1.716 2004/03/15 15:56:24 mattias
|
||||
fixed package ID string to ID conversion
|
||||
|
||||
|
||||
@ -2818,7 +2818,7 @@ begin
|
||||
Changed:=false;
|
||||
Changed:=Changed or CodeToolBoss.SetGlobalValue(
|
||||
ExternalMacroStart+'LCLWidgetType',
|
||||
Owner.CompilerOptions.LCLWidgetType);
|
||||
Owner.CompilerOptions.GetEffectiveLCLWidgetType);
|
||||
if Owner.IsVirtual then
|
||||
NewProjectDir:=VirtualDirectory
|
||||
else
|
||||
@ -2833,6 +2833,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.151 2004/03/17 11:28:35 mattias
|
||||
fixed setting project LCLWidgetSet in defines
|
||||
|
||||
Revision 1.150 2004/03/15 15:56:24 mattias
|
||||
fixed package ID string to ID conversion
|
||||
|
||||
|
||||
@ -90,7 +90,7 @@ type
|
||||
property Name: String read FName write SetName;
|
||||
property Canvas: TPostScriptCanvas read FCanvas;
|
||||
property GetPS: TStringList read GetPostscript;
|
||||
property OldName: string read FOldName write FOldName; // used when notifying that name changed
|
||||
property OldName: string read FOldName write FOldName; // used when notifying that name Changed
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
PPSPattern = ^TPSPattern; // used for array
|
||||
@ -155,7 +155,7 @@ type
|
||||
MPostScript: TPostScript;
|
||||
constructor Create(APostScript: TPostScript);
|
||||
destructor Destroy; override;
|
||||
procedure clear;
|
||||
procedure Clear;
|
||||
property PostScript: TStringList read FPostScript write FPostScript;
|
||||
property FontFace: String read FFontFace write SetFontFace;
|
||||
property FontSize: Integer read FFontSize write SetFontSize;
|
||||
@ -170,7 +170,7 @@ type
|
||||
procedure Ellipse(const Rect: TRect);
|
||||
procedure Pie(x,y,width,mheight,angle1,angle2 : Integer);
|
||||
//procedure Pie(x,y,width,height,SX,SY,EX,EY : Integer);
|
||||
procedure Writeln(AString: String);
|
||||
procedure Writeln(const AString: String);
|
||||
procedure TextOut(X,Y: Integer; const Text: String);
|
||||
//procedure Chord(x,y,width,height,angle1,angle2 : Integer);
|
||||
//procedure Chord(x,y,width,height,SX,SY,EX,EY : Integer);
|
||||
@ -219,7 +219,6 @@ type
|
||||
procedure PatternChanged(Sender: TObject);
|
||||
procedure InsertPattern(APattern: TPSPattern); // adds the pattern to the postscript
|
||||
procedure RemovePattern(APattern: TPSPattern); // remove the pattern from the postscript
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -239,8 +238,10 @@ type
|
||||
procedure EndDoc;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ TPostScriptCanvas ----------------------------------------------------------}
|
||||
|
||||
{ Y coords in postscript are backwards... }
|
||||
@ -252,9 +253,7 @@ end;
|
||||
{ Adds a fill finishing line to any path we desire to fill }
|
||||
procedure TPostScriptCanvas.AddFill;
|
||||
begin
|
||||
|
||||
FPostScript.Add('gsave '+FBrush.AsString+' fill grestore');
|
||||
|
||||
end;
|
||||
|
||||
{ Sets the current font face}
|
||||
@ -267,19 +266,16 @@ begin
|
||||
FFontFace := '('+AValue+')'
|
||||
else FFontFace:=AValue;
|
||||
|
||||
MyString := '/'+FFontFace+' '+inttostr(FFontSize)+' selectfont';
|
||||
MyString := '/'+FFontFace+' '+IntToStr(FFontSize)+' selectfont';
|
||||
// set the pen info
|
||||
|
||||
FPostScript.Add(MyString);
|
||||
|
||||
end;
|
||||
|
||||
|
||||
function TPostScriptCanvas.GetColor: TColor;
|
||||
begin
|
||||
|
||||
Result := FColor;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.SetBrush(const AValue: TPSPen);
|
||||
@ -290,17 +286,14 @@ end;
|
||||
|
||||
procedure TPostScriptCanvas.SetColor(const AValue: TColor);
|
||||
begin
|
||||
|
||||
FColor := AValue;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.SetFontSize(const AValue: Integer);
|
||||
begin
|
||||
if FFontSize=AValue then exit;
|
||||
FFontSize:=AValue;
|
||||
FPostScript.Add('/'+FFontFace+' '+inttostr(AValue)+' selectfont');
|
||||
FPostScript.Add('/'+FFontFace+' '+IntToStr(AValue)+' selectfont');
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.SetPen(const AValue: TPSPen);
|
||||
@ -317,11 +310,10 @@ begin
|
||||
// any routines that you specify a start location when calling such as
|
||||
// textout, ellipse, etc. should not affect the default cursor location.
|
||||
|
||||
FPostScript.Add(inttostr(LastX)+' '+inttostr(TranslateY(LastY))+' moveto');
|
||||
|
||||
FPostScript.Add(IntToStr(LastX)+' '+IntToStr(TranslateY(LastY))+' moveto');
|
||||
end;
|
||||
|
||||
{ This is called when drawing pen is changed but NOT when brush changes }
|
||||
{ This is called when drawing pen is Changed but NOT when brush changes }
|
||||
procedure TPostScriptCanvas.PenChanged(Sender: TObject);
|
||||
begin
|
||||
if FPostScript[FPostScript.Count-2] = '%%PEN' then begin
|
||||
@ -331,7 +323,6 @@ begin
|
||||
end;
|
||||
FPostScript.Add('%%PEN');
|
||||
FPostScript.Add(FPen.AsString);
|
||||
|
||||
end;
|
||||
|
||||
constructor TPostScriptCanvas.Create(APostScript: TPostScript);
|
||||
@ -357,8 +348,7 @@ begin
|
||||
FBrush := TPSPen.Create;
|
||||
FBrush.Width := 1;
|
||||
FBrush.Color := -1;
|
||||
// don't notify us that the brush changed...
|
||||
|
||||
// don't notify us that the brush Changed...
|
||||
end;
|
||||
|
||||
destructor TPostScriptCanvas.Destroy;
|
||||
@ -369,10 +359,9 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ Clear the postscript canvas AND the graphic canvas (add later) }
|
||||
{ Clear the postscript canvas AND the graphic canvas (Add later) }
|
||||
procedure TPostScriptCanvas.clear;
|
||||
begin
|
||||
|
||||
// clear the canvas for the next page
|
||||
FPostScript.Clear;
|
||||
// Choose a standard font in case the user doesn't
|
||||
@ -383,10 +372,9 @@ begin
|
||||
// also clear the canvas itself if we plan to embed the bitmap into
|
||||
// the postscript
|
||||
|
||||
// also grab the latest canvas height just in case it's changed
|
||||
// also grab the latest canvas height just in case it's Changed
|
||||
FHeight := 792;
|
||||
if assigned(MPostScript) then FHeight := MPostScript.Height;
|
||||
|
||||
if Assigned(MPostScript) then FHeight := MPostScript.Height;
|
||||
end;
|
||||
|
||||
{ Move draw location }
|
||||
@ -395,7 +383,7 @@ var
|
||||
Y: Integer;
|
||||
begin
|
||||
Y := TranslateY(Y1);
|
||||
FPostScript.Add(inttostr(X1)+' '+inttostr(Y)+' moveto');
|
||||
FPostScript.Add(IntToStr(X1)+' '+IntToStr(Y)+' moveto');
|
||||
LastX := X1;
|
||||
LastY := Y1;
|
||||
end;
|
||||
@ -406,26 +394,23 @@ var
|
||||
Y: Integer;
|
||||
begin
|
||||
Y := TranslateY(Y1);
|
||||
FPostScript.Add(inttostr(X1)+' '+inttostr(Y)+' lineto');
|
||||
FPostScript.Add(IntToStr(X1)+' '+IntToStr(Y)+' lineto');
|
||||
LastX := X1;
|
||||
LastY := Y1;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.Line(X1, Y1, X2, Y2: Integer);
|
||||
var
|
||||
Y12, Y22: Integer;
|
||||
begin
|
||||
|
||||
Y12 := TranslateY(Y1);
|
||||
Y22 := TranslateY(Y2);
|
||||
|
||||
FPostScript.Add('newpath '+inttostr(X1)+' '+inttostr(Y12)+' moveto '+
|
||||
inttostr(X2)+' '+inttostr(Y22)+' lineto closepath stroke');
|
||||
FPostScript.Add('newpath '+IntToStr(X1)+' '+IntToStr(Y12)+' moveto '+
|
||||
IntToStr(X2)+' '+IntToStr(Y22)+' lineto closepath stroke');
|
||||
|
||||
// go back to last moveto position
|
||||
ResetPos;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
|
||||
@ -436,15 +421,14 @@ begin
|
||||
Y22 := TranslateY(Y2);
|
||||
|
||||
FPostScript.Add('stroke newpath');
|
||||
FPostScript.Add(inttostr(X1)+' '+inttostr(Y12)+' moveto');
|
||||
FPostScript.Add(inttostr(X2)+' '+inttostr(Y12)+' lineto');
|
||||
FPostScript.Add(inttostr(X2)+' '+inttostr(Y22)+' lineto');
|
||||
FPostScript.Add(inttostr(X1)+' '+inttostr(Y22)+' lineto');
|
||||
FPostScript.Add(IntToStr(X1)+' '+IntToStr(Y12)+' moveto');
|
||||
FPostScript.Add(IntToStr(X2)+' '+IntToStr(Y12)+' lineto');
|
||||
FPostScript.Add(IntToStr(X2)+' '+IntToStr(Y22)+' lineto');
|
||||
FPostScript.Add(IntToStr(X1)+' '+IntToStr(Y22)+' lineto');
|
||||
FPostScript.Add('closepath');
|
||||
if FBrush.Color > -1 then AddFill;
|
||||
FPostScript.Add('stroke');
|
||||
ResetPos;
|
||||
|
||||
end;
|
||||
|
||||
{ Draw a rectangle }
|
||||
@ -456,15 +440,14 @@ begin
|
||||
Y22 := TranslateY(Rect.Bottom);
|
||||
|
||||
FPostScript.Add('stroke newpath');
|
||||
FPostScript.Add(inttostr(Rect.Left)+' '+inttostr(Y12)+' moveto');
|
||||
FPostScript.Add(inttostr(Rect.Right)+' '+inttostr(Y12)+' lineto');
|
||||
FPostScript.Add(inttostr(Rect.Right)+' '+inttostr(Y22)+' lineto');
|
||||
FPostScript.Add(inttostr(Rect.Left)+' '+inttostr(Y22)+' lineto');
|
||||
FPostScript.Add(IntToStr(Rect.Left)+' '+IntToStr(Y12)+' moveto');
|
||||
FPostScript.Add(IntToStr(Rect.Right)+' '+IntToStr(Y12)+' lineto');
|
||||
FPostScript.Add(IntToStr(Rect.Right)+' '+IntToStr(Y22)+' lineto');
|
||||
FPostScript.Add(IntToStr(Rect.Left)+' '+IntToStr(Y22)+' lineto');
|
||||
FPostScript.Add('closepath');
|
||||
if FBrush.Color > -1 then AddFill;
|
||||
FPostScript.Add('stroke');
|
||||
ResetPos;
|
||||
|
||||
end;
|
||||
|
||||
{ Draw a series of lines }
|
||||
@ -488,7 +471,6 @@ var
|
||||
YRatio: Real;
|
||||
centerX, centerY: Integer;
|
||||
begin
|
||||
|
||||
// set radius to half the width
|
||||
radius := (x2 - x1) div 2;
|
||||
|
||||
@ -500,14 +482,14 @@ begin
|
||||
CenterX := ((X2 - X1) div 2) + X1;
|
||||
CenterY := ((Y2 - Y1) div 2) + Y1;
|
||||
|
||||
FPostScript.Add('newpath '+inttostr(CenterX)+' '+inttostr(TranslateY(CenterY))+' translate');
|
||||
FPostScript.Add('newpath '+IntToStr(CenterX)+' '+IntToStr(TranslateY(CenterY))+' translate');
|
||||
|
||||
// move to edge
|
||||
FPostScript.Add(inttostr(radius)+' 0 moveto');
|
||||
FPostScript.Add(IntToStr(radius)+' 0 moveto');
|
||||
|
||||
// now draw it
|
||||
FPostScript.Add('gsave 1 '+format('%.3f',[YRatio])+' scale');
|
||||
FPostScript.Add('0 0 '+inttostr(radius)+' 0 360 arc');
|
||||
FPostScript.Add('0 0 '+IntToStr(radius)+' 0 360 arc');
|
||||
if FBrush.Color > -1 then AddFill;
|
||||
|
||||
// reset scale for drawing line thickness so it doesn't warp
|
||||
@ -515,31 +497,27 @@ begin
|
||||
FPostScript.Add('1 '+format('%.2f',[YRatio])+' scale stroke grestore');
|
||||
|
||||
// move origin back
|
||||
FPostScript.Add(inttostr(-CenterX)+' '+inttostr(-TranslateY(CenterY))+' translate closepath stroke');
|
||||
FPostScript.Add(IntToStr(-CenterX)+' '+IntToStr(-TranslateY(CenterY))+' translate closepath stroke');
|
||||
ResetPos;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.Ellipse(const Rect: TRect);
|
||||
begin
|
||||
|
||||
self.Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScriptCanvas.Pie(x, y, width, mheight, angle1, angle2: Integer);
|
||||
begin
|
||||
|
||||
// set zero at center
|
||||
FPostScript.Add('newpath '+inttostr(X)+' '+inttostr(TranslateY(Y))+' translate');
|
||||
FPostScript.Add('newpath '+IntToStr(X)+' '+IntToStr(TranslateY(Y))+' translate');
|
||||
|
||||
// scale it
|
||||
FPostScript.Add('gsave '+inttostr(width)+' '+inttostr(mheight)+' scale');
|
||||
FPostScript.Add('gsave '+IntToStr(width)+' '+IntToStr(mheight)+' scale');
|
||||
//FPostScript.Add('gsave 1 1 scale');
|
||||
|
||||
// draw line to edge
|
||||
FPostScript.Add('0 0 moveto');
|
||||
FPostScript.Add('0 0 1 '+inttostr(angle1)+' '+inttostr(angle2)+' arc closepath');
|
||||
FPostScript.Add('0 0 1 '+IntToStr(angle1)+' '+IntToStr(angle2)+' arc closepath');
|
||||
|
||||
if FBrush.Color > -1 then AddFill;
|
||||
|
||||
@ -548,20 +526,17 @@ begin
|
||||
FPostScript.Add(format('%.6f',[(real(1) / X)+0.01])+' '+format('%.6f',[(real(1) / Y)+0.01])+' scale stroke grestore');
|
||||
|
||||
// close out and return origin
|
||||
FPostScript.Add(inttostr(-X)+' '+inttostr(-TranslateY(Y))+' translate closepath stroke');
|
||||
|
||||
resetpos;
|
||||
FPostScript.Add(IntToStr(-X)+' '+IntToStr(-TranslateY(Y))+' translate closepath stroke');
|
||||
|
||||
ResetPos;
|
||||
end;
|
||||
|
||||
{ Writes text with a carriage return }
|
||||
procedure TPostScriptCanvas.Writeln(AString: String);
|
||||
procedure TPostScriptCanvas.Writeln(const AString: String);
|
||||
begin
|
||||
|
||||
TextOut(LastX, LastY, AString);
|
||||
LastY := LastY+FFontSize+FLineSpacing;
|
||||
MoveTo(LastX, LastY);
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -571,14 +546,11 @@ var
|
||||
Y1: Integer;
|
||||
begin
|
||||
Y1 := TranslateY(Y);
|
||||
FPostScript.Add(inttostr(X)+' '+inttostr(Y1)+' moveto');
|
||||
FPostScript.Add(IntToStr(X)+' '+IntToStr(Y1)+' moveto');
|
||||
FPostScript.Add('('+Text+') show');
|
||||
ResetPos; // move back to last moveto location
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TPostScript -------------------------------------------------------------- }
|
||||
|
||||
procedure TPostScript.SetHeight(const AValue: Integer);
|
||||
@ -605,7 +577,6 @@ begin
|
||||
|
||||
// need to not hard-link these...
|
||||
FDocument[3] := '%%Title: '+AValue;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPostScript.SetWidth(const AValue: Integer);
|
||||
@ -627,19 +598,16 @@ begin
|
||||
Document.Add(FCanvas.PostScript[I]);
|
||||
I := I+1;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
{ Take our sizes and change the boundingbox line }
|
||||
procedure TPostScript.UpdateBoundingBox;
|
||||
begin
|
||||
|
||||
// need to not hard-link this to line 1
|
||||
FDocument[1] := '%%BoundingBox: 0 0 '+inttostr(FWidth)+' '+inttostr(FHeight);
|
||||
|
||||
FDocument[1] := '%%BoundingBox: 0 0 '+IntToStr(FWidth)+' '+IntToStr(FHeight);
|
||||
end;
|
||||
|
||||
{ Pattern changed so update the postscript code }
|
||||
{ Pattern Changed so update the postscript code }
|
||||
procedure TPostScript.PatternChanged(Sender: TObject);
|
||||
begin
|
||||
// called anytime a pattern changes. Update the postscript code.
|
||||
@ -673,7 +641,6 @@ begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
{Remove a pattern from the postscript code }
|
||||
@ -763,7 +730,7 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
{ add a pattern to the array }
|
||||
{ Add a pattern to the array }
|
||||
procedure TPostScript.AddPattern(APSPattern: TPSPattern);
|
||||
begin
|
||||
// does NOT create the pattern, just insert in the array of patterns
|
||||
@ -773,7 +740,6 @@ begin
|
||||
reallocmem(Patterns, sizeof(TPSPattern) * NumPatterns);
|
||||
|
||||
Patterns[NumPatterns-1] := APSPattern;
|
||||
|
||||
end;
|
||||
|
||||
{ Find a pattern object by it's name }
|
||||
@ -789,7 +755,6 @@ begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TPostScript.DelPattern(AName: String): Boolean;
|
||||
@ -801,24 +766,21 @@ begin
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
|
||||
{ Create a new pattern and inserts it into the array for safe keeping }
|
||||
function TPostScript.NewPattern(AName: String): TPSPattern;
|
||||
var
|
||||
MyPattern: TPSPattern;
|
||||
begin
|
||||
|
||||
MyPattern := TPSPattern.Create;
|
||||
AddPattern(MyPattern);
|
||||
MyPattern.Name := AName;
|
||||
MyPattern.OnChange := @PatternChanged;
|
||||
MyPattern.OldName := '';
|
||||
|
||||
// add this to the postscript now...
|
||||
// Add this to the postscript now...
|
||||
|
||||
InsertPattern(MyPattern);
|
||||
result := MyPattern;
|
||||
|
||||
end;
|
||||
|
||||
{ Start a new document }
|
||||
@ -866,7 +828,6 @@ end;
|
||||
{ Copy current page into the postscript and start a new one }
|
||||
procedure TPostScript.NewPage;
|
||||
begin
|
||||
|
||||
// dump the current page into our postscript first
|
||||
GrabCanvas;
|
||||
|
||||
@ -875,10 +836,9 @@ begin
|
||||
FDocument.Add('showpage');
|
||||
FPageNumber := FPageNumber+1;
|
||||
// start new page definition...
|
||||
FDocument.Add('%%Page: '+inttostr(FPageNumber)+' '+inttostr(FPageNumber));
|
||||
FDocument.Add('%%Page: '+IntToStr(FPageNumber)+' '+IntToStr(FPageNumber));
|
||||
FDocument.Add('newpath');
|
||||
FCanvas.Clear;
|
||||
|
||||
end;
|
||||
|
||||
{ Finish off the document }
|
||||
@ -890,7 +850,7 @@ begin
|
||||
// Start printing the document after closing out the pages
|
||||
FDocument.Add('stroke');
|
||||
FDocument.Add('showpage');
|
||||
FDocument.Add('%%Pages: '+inttostr(FPageNumber));
|
||||
FDocument.Add('%%Pages: '+IntToStr(FPageNumber));
|
||||
|
||||
// okay, the postscript is all ready, so dump it to the text file
|
||||
// or to the printer
|
||||
@ -901,10 +861,8 @@ end;
|
||||
|
||||
procedure TPSObject.Changed;
|
||||
begin
|
||||
|
||||
Assert(False, Format('Trace:[TgraphicsObject.Changed] %s', [ClassName]));
|
||||
if Assigned(FOnChange) then FOnChange(Self);
|
||||
|
||||
end;
|
||||
|
||||
procedure TPSObject.Lock;
|
||||
@ -923,31 +881,25 @@ procedure TPSPen.SetPattern(const AValue: TPSPattern);
|
||||
begin
|
||||
if FPattern=AValue then exit;
|
||||
FPattern:=AValue;
|
||||
changed;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
|
||||
procedure TPSPen.SetColor(Value: TColor);
|
||||
begin
|
||||
|
||||
FColor := Value;
|
||||
changed;
|
||||
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPSPen.Setwidth(value: Real);
|
||||
begin
|
||||
|
||||
FWidth := Value;
|
||||
changed;
|
||||
|
||||
Changed;
|
||||
end;
|
||||
|
||||
constructor TPSPen.Create;
|
||||
begin
|
||||
|
||||
FPattern := nil;
|
||||
|
||||
end;
|
||||
|
||||
destructor TPSPen.Destroy;
|
||||
@ -963,7 +915,6 @@ begin
|
||||
FWidth := Source.Width;
|
||||
FColor := Source.Color;
|
||||
FPattern := Source.Pattern;
|
||||
|
||||
end;
|
||||
|
||||
{ Return the pen definition as a postscript string }
|
||||
@ -983,17 +934,16 @@ begin
|
||||
MyOut := '/Pattern setcolorspace '+FPattern.Name+' setcolor '
|
||||
else begin
|
||||
// now for uncolored, use color from pen
|
||||
MyOut := '[/Pattern /DeviceRGB] setcolorspace '+inttostr(GetRValue(FColor))+' '+inttostr(GetGValue(FColor))+' '+
|
||||
inttostr(GetBValue(FColor))+' '+FPattern.Name+' setcolor ';
|
||||
MyOut := '[/Pattern /DeviceRGB] setcolorspace '+IntToStr(GetRValue(FColor))+' '+IntToStr(GetGValue(FColor))+' '+
|
||||
IntToStr(GetBValue(FColor))+' '+FPattern.Name+' setcolor ';
|
||||
end;
|
||||
|
||||
end else // no pattern do this:
|
||||
MyOut := inttostr(GetRValue(FColor))+' '+inttostr(GetGValue(FColor))+' '+
|
||||
inttostr(GetBValue(FColor))+' setrgbcolor ';
|
||||
MyOut := IntToStr(GetRValue(FColor))+' '+IntToStr(GetGValue(FColor))+' '+
|
||||
IntToStr(GetBValue(FColor))+' setrgbcolor ';
|
||||
|
||||
MyOut := MyOut + format('%f',[FWidth])+' setlinewidth ';
|
||||
Result := MyOut;
|
||||
|
||||
end;
|
||||
|
||||
{ TPSPattern }
|
||||
@ -1003,7 +953,6 @@ function TPSPattern.GetpostScript: TStringList;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
|
||||
// If nothing in the canvas, error
|
||||
if FCanvas.Postscript.Count < 1 then begin
|
||||
raise exception.create('Empty pattern');
|
||||
@ -1012,31 +961,31 @@ begin
|
||||
|
||||
FPostScript.Clear;
|
||||
With FPostScript do begin
|
||||
add('%% PATTERN '+FName);
|
||||
add('/'+FName+'proto 12 dict def '+FName+'proto begin');
|
||||
add('/PatternType 1 def');
|
||||
Add('%% PATTERN '+FName);
|
||||
Add('/'+FName+'proto 12 dict def '+FName+'proto begin');
|
||||
Add('/PatternType 1 def');
|
||||
case FPaintType of
|
||||
ptColored: add('/PaintType 1 def');
|
||||
ptUncolored: add('/PaintType 2 def');
|
||||
ptColored: Add('/PaintType 1 def');
|
||||
ptUncolored: Add('/PaintType 2 def');
|
||||
end;
|
||||
case FTilingType of
|
||||
ttConstant: add('/TilingType 1 def');
|
||||
ttNoDistortion: add('/TilingType 2 def');
|
||||
ttFast: add('/TilingType 3 def');
|
||||
ttConstant: Add('/TilingType 1 def');
|
||||
ttNoDistortion: Add('/TilingType 2 def');
|
||||
ttFast: Add('/TilingType 3 def');
|
||||
end;
|
||||
add('/BBox ['+inttostr(FBBox.Left)+' '+inttostr(FBBox.Top)+' '+inttostr(FBBox.Right)+' '+inttostr(FBBox.Bottom)+'] def');
|
||||
add('/XStep '+format('%f',[FXStep])+' def');
|
||||
add('/YStep '+format('%f',[FYstep])+' def');
|
||||
add('/PaintProc { begin');
|
||||
Add('/BBox ['+IntToStr(FBBox.Left)+' '+IntToStr(FBBox.Top)+' '+IntToStr(FBBox.Right)+' '+IntToStr(FBBox.Bottom)+'] def');
|
||||
Add('/XStep '+format('%f',[FXStep])+' def');
|
||||
Add('/YStep '+format('%f',[FYstep])+' def');
|
||||
Add('/PaintProc { begin');
|
||||
|
||||
// insert the canvas
|
||||
for I := 0 to FCanvas.PostScript.Count - 1 do begin
|
||||
add(FCanvas.PostScript[I]);
|
||||
Add(FCanvas.PostScript[I]);
|
||||
end;
|
||||
|
||||
// add support for custom matrix later
|
||||
add('end } def end '+FName+'proto [1 0 0 1 0 0] makepattern /'+FName+' exch def');
|
||||
add('%% END PATTERN '+FName);
|
||||
// Add support for custom matrix later
|
||||
Add('end } def end '+FName+'proto [1 0 0 1 0 0] makepattern /'+FName+' exch def');
|
||||
Add('%% END PATTERN '+FName);
|
||||
end;
|
||||
Result := FPostScript;
|
||||
end;
|
||||
@ -1052,7 +1001,6 @@ end;
|
||||
|
||||
procedure TPSPattern.SetName(const AValue: String);
|
||||
begin
|
||||
|
||||
FOldName := FName;
|
||||
if FName=AValue then exit;
|
||||
FName:=AValue;
|
||||
@ -1068,39 +1016,37 @@ procedure TPSPattern.SetPaintType(const AValue: TPSPaintType);
|
||||
begin
|
||||
if FPaintType=AValue then exit;
|
||||
FPaintType:=AValue;
|
||||
changed;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPSPattern.SetTilingType(const AValue: TPSTileType);
|
||||
begin
|
||||
if FTilingType=AValue then exit;
|
||||
FTilingType:=AValue;
|
||||
changed;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPSPattern.SetXStep(const AValue: Real);
|
||||
begin
|
||||
if FXStep=AValue then exit;
|
||||
FXStep:=AValue;
|
||||
changed;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPSPattern.SetYStep(const AValue: Real);
|
||||
begin
|
||||
if FYStep=AValue then exit;
|
||||
FYStep:=AValue;
|
||||
changed;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
constructor TPSPattern.Create;
|
||||
begin
|
||||
|
||||
FPostScript := TStringList.Create;
|
||||
FPaintType := ptColored;
|
||||
FTilingType := ttConstant;
|
||||
FCanvas := TPostScriptCanvas.Create(nil);
|
||||
FName := 'Pattern1';
|
||||
|
||||
end;
|
||||
|
||||
destructor TPSPattern.Destroy;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user